git.iko.soy/elk
on fb08d70 help sign in
elk/src/Reporting/Error/Syntax.hs
149 lines 5.2 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 "Problem when parsing your code!"
36 (unlines (map parseErrorHint messages))
38 InfixDuplicate opName ->
39 Report.simple
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 ("There is a type annotation for '" ++ valueName ++ "' but there"
53 ++ "is no corresponding definition!"
54 )
55 ("Directly below the type annotation, put a definition like:\n\n"
56 ++ " " ++ valueName ++ " = 42"
57 )
59 PortWithoutAnnotation portName ->
60 Report.simple
61 ("Port '" ++ portName ++ "' does not have a type annotation!")
62 ("Directly above the port definition, I need something like this:\n\n"
63 ++ " port " ++ portName ++ " : Signal Int"
64 )
66 DuplicateValueDeclaration name ->
67 Report.simple
68 ("Naming multiple top-level values '" ++ name ++ "' makes things\n"
69 ++ "ambiguous. When you say '" ++ name ++ "' which one do you want?!"
70 )
71 ("Find all the top-level values named '" ++ name ++ "' and\n"
72 ++ "do some renaming. Make sure the names are distinct!"
73 )
75 DuplicateTypeDeclaration name ->
76 Report.simple
77 ("Naming multiple types '" ++ name ++ "' makes things ambiguous\n"
78 ++ "When you say '" ++ name ++ "' which one do you want?!"
79 )
80 ("Find all the types named '" ++ name ++ "' and\n"
81 ++ "do some renaming. Make sure the names are distinct!"
82 )
84 DuplicateDefinition name ->
85 Report.simple
86 ("Naming multiple values '" ++ name ++ "' in a single let-expression makes\n"
87 ++ "things ambiguous. When you say '" ++ name ++ "' which one do you want?!"
88 )
89 ("Find all the values named '" ++ name ++ "' in this let-expression and\n"
90 ++ "do some renaming. Make sure the names are distinct!"
91 )
93 UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->
94 unboundTypeVars typeName tvar tvars $ P.render $
95 P.hang
96 (P.text "type alias" <+> P.text typeName <+> P.hsep vars <+> P.equals)
97 4
98 (P.pretty False tipe)
99 where
100 vars = map P.text (givenVars ++ tvar : tvars)
103 UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->
104 unboundTypeVars typeName tvar tvars $ P.render $
105 P.vcat
106 [ P.text "type" <+> P.text typeName <+> P.hsep vars
107 , map toDoc ctors
108 |> zipWith (<+>) (P.text "=" : repeat (P.text "|"))
109 |> P.vcat
110 |> P.nest 4
111 ]
112 where
113 vars = map P.text (givenVars ++ tvar : tvars)
114 toDoc (ctor, args) =
115 P.text ctor <+> P.hsep (map (P.pretty True) args)
118unboundTypeVars :: String -> String -> [String] -> String -> Report.Report
119unboundTypeVars typeName tvar tvars revisedDeclaration =
120 let
121 s = if null tvars then "" else "s"
122 in
123 Report.simple
124 ("Type '" ++ typeName ++ "' uses unbound type variable" ++ s ++ ": "
125 ++ List.intercalate ", " (tvar:tvars)
126 )
127 ("All type variables must be listed to avoid sneaky type errors.\n"
128 ++ "Imagine one '" ++ typeName ++ "' where '" ++ tvar ++ "' is an Int and\n"
129 ++ "another where it is a Bool. They both look like a '" ++ typeName ++ "'\n"
130 ++ "to the type checker, but they are actually different types!\n\n"
131 ++ "Maybe you want a definition like this?\n"
132 ++ concatMap ("\n "++) (lines revisedDeclaration)
133 )
136parseErrorHint :: Parsec.Message -> String
137parseErrorHint message =
138 case message of
139 Parsec.SysUnExpect msg ->
140 "SysUnExpect: " ++ msg
142 Parsec.UnExpect msg ->
143 "UnExpect: " ++ msg
145 Parsec.Expect msg ->
146 "UnExpect: " ++ msg
148 Parsec.Message msg ->
149 "UnExpect: " ++ msg