git.iko.soy/elk
on master help sign in
Resolve TODOs in Validate
70933c9Evan Czaplicki
src/Reporting/Error/Syntax.hs+24−5
compare with master
unifiedsplit
@@ -30,6 +30,7 @@ import qualified Reporting.Helpers as H
30data Error
30data Error
31 = CommentOnNothing R.Region
31 = CommentOnNothing R.Region
32 | UnexpectedPort R.Region N.Name
32 | UnexpectedPort R.Region N.Name
33+ | TypeWithBadDefinition R.Region N.Name N.Name
33 | TypeWithoutDefinition R.Region N.Name
34 | TypeWithoutDefinition R.Region N.Name
34 | Parse R.Region (Maybe R.Region) Problem
35 | Parse R.Region (Maybe R.Region) Problem
35
36
@@ -89,7 +90,7 @@ data Theory
89data Next
90data Next
90 = Decl
91 = Decl
91 | Expr
92 | Expr
92− | AfterOpExpr Text
93+ | AfterOpExpr N.Name
93 | ElseBranch
94 | ElseBranch
94 | Arg
95 | Arg
95 | Pattern
96 | Pattern
@@ -127,7 +128,7 @@ data Context
127 | TypeAlias
128 | TypeAlias
128 | Infix
129 | Infix
129 | Port
130 | Port
130− deriving (Eq, Ord, Show)
131+ deriving (Eq, Ord)
131
132
132
133
133
134
@@ -165,16 +166,34 @@ toReport source err =
165 ]
166 ]
166 )
167 )
167
168
169+ TypeWithBadDefinition region annName defName ->
170+ Report.Report "ANNOTATION MISMATCH" region [] $
171+ Report.toCodeSnippet source region Nothing
172+ (
173+ H.reflow $
174+ "I see a `" <> N.toString annName
175+ <> "` annotation, but it is followed by a `"
176+ <> N.toString defName <> "` definition."
177+ ,
178+ H.fillSep
179+ ["The","annotation","and","definition","names","must","match!"
180+ ,"Is","there","a","typo","between"
181+ , H.dullyellow (H.nameToDoc annName)
182+ ,"and"
183+ , H.dullyellow (H.nameToDoc defName) <> "?"
184+ ]
185+ )
186+
168− TypeWithoutDefinition region valueName ->
187+ TypeWithoutDefinition region name ->
169 Report.Report "MISSING DEFINITION" region [] $
188 Report.Report "MISSING DEFINITION" region [] $
170 Report.toCodeSnippet source region Nothing
189 Report.toCodeSnippet source region Nothing
171 (
190 (
172 H.reflow $
191 H.reflow $
173− "There is a type annotation for `" <> N.toString valueName
192+ "There is a type annotation for `" <> N.toString name
174 <> "` but there is no corresponding definition!"
193 <> "` but there is no corresponding definition!"
175 ,
194 ,
176 "Directly below the type annotation, put a definition like:\n\n"
195 "Directly below the type annotation, put a definition like:\n\n"
177− <> " " <> H.nameToDoc valueName <> " = 42"
196+ <> " " <> H.nameToDoc name <> " = 42"
178 )
197 )
179
198
180 Parse region subRegion problem ->
199 Parse region subRegion problem ->
src/Validate.hs+19−19
@@ -85,7 +85,7 @@ vsdHelp decls stuff =
85 vsdHelp otherDecls $ stuff { _ports = port_ : _ports stuff }
85 vsdHelp otherDecls $ stuff { _ports = port_ : _ports stuff }
86
86
87 Src.Docs docs ->
87 Src.Docs docs ->
88− validateDocs docs otherDecls stuff
88+ validateDocs region docs otherDecls stuff
89
89
90 Src.Annotation (A.At _ name) tipe ->
90 Src.Annotation (A.At _ name) tipe ->
91 validateAnnotation region name tipe otherDecls stuff
91 validateAnnotation region name tipe otherDecls stuff
@@ -100,40 +100,40 @@ vsdHelp decls stuff =
100-- VALIDATE DOCS
100-- VALIDATE DOCS
101
101
102
102
103−validateDocs :: Text -> [Src.Decl] -> Stuff -> Result i w Stuff
103+validateDocs :: R.Region -> Text -> [Src.Decl] -> Stuff -> Result i w Stuff
104−validateDocs docs decls stuff =
104+validateDocs region docs decls stuff =
105 case decls of
105 case decls of
106 [] ->
106 [] ->
107− error "TODO no docs on nothing"
107+ Result.throw (Error.CommentOnNothing region)
108
108
109 A.At _ decl : _ ->
109 A.At _ decl : _ ->
110− do name <- getNameForDocs decl
110+ do name <- getNameForDocs region decl
111 vsdHelp decls $ stuff { _docs = Map.insert name docs (_docs stuff) }
111 vsdHelp decls $ stuff { _docs = Map.insert name docs (_docs stuff) }
112
112
113
113
114−getNameForDocs :: Src.Decl_ -> Result i w N.Name
114+getNameForDocs :: R.Region -> Src.Decl_ -> Result i w N.Name
115−getNameForDocs decl =
115+getNameForDocs region decl =
116 case decl of
116 case decl of
117 Src.Union (A.At _ name) _ _ ->
117 Src.Union (A.At _ name) _ _ ->
118− return name
118+ Result.ok name
119
119
120 Src.Alias (A.At _ name) _ _ ->
120 Src.Alias (A.At _ name) _ _ ->
121− return name
121+ Result.ok name
122
122
123− Src.Binop _ _ _ _ ->
123+ Src.Binop name _ _ _ ->
124− error "TODO no docs on binop"
124+ Result.ok name
125
125
126− Src.Port _ _ ->
126+ Src.Port (A.At _ name) _ ->
127− error "TODO no docs on ports"
127+ Result.ok name
128
128
129 Src.Docs _ ->
129 Src.Docs _ ->
130− error "TODO no docs on docs"
130+ Result.throw (Error.CommentOnNothing region)
131
131
132 Src.Annotation (A.At _ name) _ ->
132 Src.Annotation (A.At _ name) _ ->
133− return name
133+ Result.ok name
134
134
135 Src.Definition (A.At _ name) _ _ ->
135 Src.Definition (A.At _ name) _ _ ->
136− return name
136+ Result.ok name
137
137
138
138
139
139
@@ -144,7 +144,7 @@ validateAnnotation :: R.Region -> N.Name -> Src.Type -> [Src.Decl] -> Stuff -> R
144validateAnnotation annRegion annotationName tipe decls stuff =
144validateAnnotation annRegion annotationName tipe decls stuff =
145 case decls of
145 case decls of
146 [] ->
146 [] ->
147− error "TODO no attotations on nothing"
147+ Result.throw (Error.TypeWithoutDefinition annRegion annotationName)
148
148
149 A.At defRegion decl : otherDecls ->
149 A.At defRegion decl : otherDecls ->
150 case decl of
150 case decl of
@@ -156,10 +156,10 @@ validateAnnotation annRegion annotationName tipe decls stuff =
156 vsdHelp otherDecls $ stuff { _decls = validDecl : _decls stuff }
156 vsdHelp otherDecls $ stuff { _decls = validDecl : _decls stuff }
157
157
158 else
158 else
159− error "TODO annotation does not match following definition"
159+ Result.throw (Error.TypeWithBadDefinition annRegion annotationName definitionName)
160
160
161 _ ->
161 _ ->
162− error "TODO annotation needs to be on a definition"
162+ Result.throw (Error.TypeWithoutDefinition annRegion annotationName)
163
163
164
164
165
165