on 4a5d921 help sign in
elk/src/Reporting/Error/Syntax.hs
154 lines 5.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Syntax where
4import qualified Data.List as List
5import qualified Text.Parsec.Error as Parsec
6import qualified Text.PrettyPrint as P
7import Text.PrettyPrint ((<+>))
9import qualified AST.Helpers as Help
10import qualified AST.Type as Type
11import Elm.Utils ((|>))
12import qualified Reporting.PrettyPrint as P
13import qualified Reporting.Report as Report
16data Error
17 = Parse [Parsec.Message]
18 | InfixDuplicate String
19 | TypeWithoutDefinition String
20 | PortWithoutAnnotation String
21 | DuplicateValueDeclaration String
22 | DuplicateTypeDeclaration String
23 | DuplicateDefinition String
24 | UnboundTypeVarsInAlias String [String] String [String] Type.Raw
25 | UnboundTypeVarsInUnion String [String] String [String] [(String, [Type.Raw])]
28-- TO REPORT
30toReport :: Error -> Report.Report
31toReport err =
32 case err of
33 Parse messages ->
34 Report.simple
35 "SYNTAX PROBLEM"
36 "Problem when parsing your code!"
37 (unlines (map parseErrorHint messages))
39 InfixDuplicate opName ->
40 Report.simple
41 "INFIX OVERLAP"
42 ("The infix declarations for " ++ operator ++ " must be removed.")
43 ("The precedence and associativity can only be set in one place, and\n"
44 ++ "this information has already been set somewhere else."
45 )
46 where
47 operator =
48 if Help.isOp opName
49 then "(" ++ opName ++ ")"
50 else "`" ++ opName ++ "`"
52 TypeWithoutDefinition valueName ->
53 Report.simple
54 "MISSING DEFINITION"
55 ("There is a type annotation for '" ++ valueName ++ "' but there"
56 ++ "is no corresponding definition!"
57 )
58 ("Directly below the type annotation, put a definition like:\n\n"
59 ++ " " ++ valueName ++ " = 42"
60 )
62 PortWithoutAnnotation portName ->
63 Report.simple
64 "PORT ERROR"
65 ("Port '" ++ portName ++ "' does not have a type annotation!")
66 ("Directly above the port definition, I need something like this:\n\n"
67 ++ " port " ++ portName ++ " : Signal Int"
68 )
70 DuplicateValueDeclaration name ->
71 Report.simple
72 "DUPLICATE DEFINITION"
73 ("Naming multiple top-level values '" ++ name ++ "' makes things\n"
74 ++ "ambiguous. When you say '" ++ name ++ "' which one do you want?!"
75 )
76 ("Find all the top-level values named '" ++ name ++ "' and\n"
77 ++ "do some renaming. Make sure the names are distinct!"
78 )
80 DuplicateTypeDeclaration name ->
81 Report.simple
82 "DUPLICATE DEFINITION"
83 ("Naming multiple types '" ++ name ++ "' makes things ambiguous\n"
84 ++ "When you say '" ++ name ++ "' which one do you want?!"
85 )
86 ("Find all the types named '" ++ name ++ "' and\n"
87 ++ "do some renaming. Make sure the names are distinct!"
88 )
90 DuplicateDefinition name ->
91 Report.simple
92 "DUPLICATE DEFINITION"
93 ("Naming multiple values '" ++ name ++ "' in a single let-expression makes\n"
94 ++ "things ambiguous. When you say '" ++ name ++ "' which one do you want?!"
95 )
96 ("Find all the values named '" ++ name ++ "' in this let-expression and\n"
97 ++ "do some renaming. Make sure the names are distinct!"
98 )
100 UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->
101 unboundTypeVars typeName tvar tvars $ P.render $
102 P.hang
103 (P.text "type alias" <+> P.text typeName <+> P.hsep vars <+> P.equals)
104 4
105 (P.pretty False tipe)
106 where
107 vars = map P.text (givenVars ++ tvar : tvars)
110 UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->
111 unboundTypeVars typeName tvar tvars $ P.render $
112 P.vcat
113 [ P.text "type" <+> P.text typeName <+> P.hsep vars
114 , map toDoc ctors
115 |> zipWith (<+>) (P.text "=" : repeat (P.text "|"))
116 |> P.vcat
117 |> P.nest 4
118 ]
119 where
120 vars = map P.text (givenVars ++ tvar : tvars)
121 toDoc (ctor, args) =
122 P.text ctor <+> P.hsep (map (P.pretty True) args)
125unboundTypeVars :: String -> String -> [String] -> String -> Report.Report
126unboundTypeVars typeName tvar tvars revisedDeclaration =
127 Report.simple
128 "UNBOUND TYPE VARS"
129 ( "Not all type variables in '" ++ typeName ++ "' are listed, making sneaky\n"
130 ++ "type errors possible. Unbound type variables include: "
131 ++ List.intercalate ", " (tvar:tvars)
132 )
133 ( "You probably want this definition instead:\n"
134 ++ concatMap ("\n "++) (lines revisedDeclaration) ++ "\n\n"
135 ++ "Here's why. Imagine one '" ++ typeName ++ "' where '" ++ tvar ++ "' is an Int and\n"
136 ++ "another where it is a Bool. When we explicitly list the type variables, type\n"
137 ++ "checker can see that they are actually different types."
138 )
141parseErrorHint :: Parsec.Message -> String
142parseErrorHint message =
143 case message of
144 Parsec.SysUnExpect msg ->
145 "SysUnExpect: " ++ msg
147 Parsec.UnExpect msg ->
148 "UnExpect: " ++ msg
150 Parsec.Expect msg ->
151 "UnExpect: " ++ msg
153 Parsec.Message msg ->
154 "UnExpect: " ++ msg