git.iko.soy/elk
on 7be0e81 help sign in
elk/src/Reporting/Error/Syntax.hs
220 lines 6.9 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 | DuplicateValueDeclaration String
23 | DuplicateTypeDeclaration String
24 | DuplicateDefinition String
25 | UnboundTypeVarsInAlias String [String] String [String] Type.Raw
26 | UnboundTypeVarsInUnion String [String] String [String] [(String, [Type.Raw])]
29-- TO REPORT
31toReport :: Error -> Report.Report
32toReport err =
33 case err of
34 Parse messages ->
35 parseErrorReport messages
37 InfixDuplicate opName ->
38 Report.simple
39 "INFIX OVERLAP"
40 ("The infix declarations for " ++ operator ++ " must be removed.")
41 ("The precedence and associativity can only be set in one place, and\n"
42 ++ "this information has already been set somewhere else."
43 )
44 where
45 operator =
46 if Help.isOp opName
47 then "(" ++ opName ++ ")"
48 else "`" ++ opName ++ "`"
50 TypeWithoutDefinition valueName ->
51 Report.simple
52 "MISSING DEFINITION"
53 ("There is a type annotation for '" ++ valueName ++ "' but there"
54 ++ "is no corresponding definition!"
55 )
56 ("Directly below the type annotation, put a definition like:\n\n"
57 ++ " " ++ valueName ++ " = 42"
58 )
60 PortWithoutAnnotation portName ->
61 Report.simple
62 "PORT ERROR"
63 ("Port '" ++ portName ++ "' does not have a type annotation!")
64 ("Directly above the port definition, I need something like this:\n\n"
65 ++ " port " ++ portName ++ " : Signal Int"
66 )
68 DuplicateValueDeclaration name ->
69 Report.simple
70 "DUPLICATE DEFINITION"
71 ("Naming multiple top-level values '" ++ name ++ "' makes things\n"
72 ++ "ambiguous. When you say '" ++ name ++ "' which one do you want?!"
73 )
74 ("Find all the top-level values named '" ++ name ++ "' and\n"
75 ++ "do some renaming. Make sure the names are distinct!"
76 )
78 DuplicateTypeDeclaration name ->
79 Report.simple
80 "DUPLICATE DEFINITION"
81 ("Naming multiple types '" ++ name ++ "' makes things ambiguous\n"
82 ++ "When you say '" ++ name ++ "' which one do you want?!"
83 )
84 ("Find all the types named '" ++ name ++ "' and\n"
85 ++ "do some renaming. Make sure the names are distinct!"
86 )
88 DuplicateDefinition name ->
89 Report.simple
90 "DUPLICATE DEFINITION"
91 ("Naming multiple values '" ++ name ++ "' in a single let-expression makes\n"
92 ++ "things ambiguous. When you say '" ++ name ++ "' which one do you want?!"
93 )
94 ("Find all the values named '" ++ name ++ "' in this let-expression and\n"
95 ++ "do some renaming. Make sure the names are distinct!"
96 )
98 UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->
99 unboundTypeVars typeName tvar tvars $ P.render $
100 P.hang
101 (P.text "type alias" <+> P.text typeName <+> P.hsep vars <+> P.equals)
102 4
103 (P.pretty False tipe)
104 where
105 vars = map P.text (givenVars ++ tvar : tvars)
108 UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->
109 unboundTypeVars typeName tvar tvars $ P.render $
110 P.vcat
111 [ P.text "type" <+> P.text typeName <+> P.hsep vars
112 , map toDoc ctors
113 |> zipWith (<+>) (P.text "=" : repeat (P.text "|"))
114 |> P.vcat
115 |> P.nest 4
116 ]
117 where
118 vars = map P.text (givenVars ++ tvar : tvars)
119 toDoc (ctor, args) =
120 P.text ctor <+> P.hsep (map (P.pretty True) args)
123unboundTypeVars :: String -> String -> [String] -> String -> Report.Report
124unboundTypeVars typeName tvar tvars revisedDeclaration =
125 Report.simple
126 "UNBOUND TYPE VARS"
127 ( "Not all type variables in '" ++ typeName ++ "' are listed, making sneaky\n"
128 ++ "type errors possible. Unbound type variables include: "
129 ++ List.intercalate ", " (tvar:tvars)
130 )
131 ( "You probably want this definition instead:\n"
132 ++ concatMap ("\n "++) (lines revisedDeclaration) ++ "\n\n"
133 ++ "Here's why. Imagine one '" ++ typeName ++ "' where '" ++ tvar ++ "' is an Int and\n"
134 ++ "another where it is a Bool. When we explicitly list the type variables, type\n"
135 ++ "checker can see that they are actually different types."
136 )
139-- TAGGING PARSE ERRORS
141newline :: String
142newline = "NEWLINE"
144freshLine :: String
145freshLine = "FRESH_LINE"
147whitespace :: String
148whitespace = "WHITESPACE"
150keyword :: String -> String
151keyword kwd =
152 "KEYWORD=" ++ kwd
154unkeyword :: String -> Maybe String
155unkeyword message =
156 if List.isPrefixOf "KEYWORD=" message
157 then Just (drop (length "KEYWORD=") message)
158 else Nothing
161-- REPORTING PARSE ERRORS
163parseErrorReport :: [Parsec.Message] -> Report.Report
164parseErrorReport messages =
165 let
166 addMsg message hint =
167 case message of
168 Parsec.SysUnExpect _msg ->
169 hint
171 Parsec.UnExpect _msg ->
172 hint
174 Parsec.Expect msg ->
175 let
176 msg' =
177 if msg `elem` [whitespace, newline, freshLine]
178 then "whitespace"
179 else msg
180 in
181 hint { _expected = Set.insert msg' (_expected hint) }
183 Parsec.Message msg ->
184 hint { _messages = msg : _messages hint }
186 (ParseHint msgs expects) =
187 foldr addMsg emptyHint messages
189 preHint =
190 case msgs of
191 [msg] ->
192 case unkeyword msg of
193 Just kwd ->
194 "It looks like the keyword '" ++ kwd ++ "' is being used as a variable.\n"
195 ++ "Try renaming it to something else."
196 Nothing ->
197 msg
199 _ -> "I ran into something unexpected when parsing your code!"
201 postHint =
202 if Set.null expects
203 then ""
204 else
205 "I am looking for one of the following things:\n"
206 ++ concatMap ("\n "++) (Set.toList expects)
207 in
208 Report.simple "SYNTAX PROBLEM" preHint postHint
211data ParseHint = ParseHint
212 { _messages :: [String]
213 , _expected :: Set.Set String
214 }
215 deriving (Show)
218emptyHint :: ParseHint
219emptyHint =
220 ParseHint [] Set.empty