git.iko.soy/elk
on f4401ac help sign in
elk/compiler/src/Reporting/Error/Json.hs
332 lines 11 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error.Json
4 ( toReport
5 , FailureToReport(..)
6 , Context(..)
7 , Reason(..)
8 )
9 where
12import qualified Data.ByteString as BS
13import qualified Data.ByteString.UTF8 as BS_UTF8
14import qualified Data.NonEmptyList as NE
16import Json.Decode (Error(..), Problem(..), DecodeExpectation(..), ParseError(..), StringProblem(..))
17import qualified Reporting.Annotation as A
18import qualified Reporting.Doc as D
19import qualified Reporting.Exit.Help as Help
20import qualified Reporting.Render.Code as Code
24-- TO REPORT
27toReport :: FilePath -> FailureToReport x -> Error x -> Reason -> Help.Report
28toReport path ftr err reason =
29 case err of
30 DecodeProblem bytes problem ->
31 problemToReport path ftr (Code.toSource bytes) CRoot problem reason
33 ParseProblem bytes parseError ->
34 parseErrorToReport path (Code.toSource bytes) parseError reason
37newtype Reason =
38 ExplicitReason String
41because :: Reason -> String -> String
42because (ExplicitReason iNeedThings) problem =
43 iNeedThings ++ " " ++ problem
47-- PARSE ERROR TO REPORT
50parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Report
51parseErrorToReport path source parseError reason =
52 let
53 toSnippet title row col (problem, details) =
54 let pos = A.Position row col in
55 Help.jsonReport title (Just path) $
56 Code.toSnippet source (A.Region pos pos) Nothing
57 ( D.reflow (because reason problem)
58 , details
59 )
60 in
61 case parseError of
62 Start row col ->
63 toSnippet "EXPECTING A VALUE" row col
64 (
65 "I was expecting to see a JSON value next:"
66 ,
67 D.stack
68 [ D.fillSep
69 ["Try","something","like",D.dullyellow "\"this\"","or"
70 ,D.dullyellow "42","to","move","on","to","better","hints!"
71 ]
72 , D.toSimpleNote $
73 "The JSON specification does not allow trailing commas, so you can sometimes\
74 \ get this error in arrays that have an extra comma at the end. In that case,\
75 \ remove that last comma or add another array entry after it!"
76 ]
77 )
79 ObjectField row col ->
80 toSnippet "UNFINISHED OBJECT" row col
81 (
82 "I was partway through parsing a JSON object when I got stuck here:"
83 ,
84 D.stack
85 [ D.reflow $ "I was expecting to see a field name next."
86 , objectNote
87 ]
88 )
90 ObjectColon row col ->
91 toSnippet "EXPECTING COLON" row col
92 (
93 "I was partway through parsing a JSON object when I got stuck here:"
94 ,
95 D.stack
96 [ D.reflow $ "I was expecting to see a colon next."
97 , objectNote
98 ]
99 )
101 ObjectEnd row col ->
102 toSnippet "UNFINISHED OBJECT" row col
103 (
104 "I was partway through parsing a JSON object when I got stuck here:"
105 ,
106 D.stack
107 [ D.reflow $
108 "I was expecting to see a comma or a closing curly brace next."
109 , D.reflow $
110 "Is a comma missing on the previous line? Is an array missing a closing square\
111 \ bracket? It is often something tricky like that!"
112 , objectNote
113 ]
114 )
116 ArrayEnd row col ->
117 toSnippet "UNFINISHED ARRAY" row col
118 (
119 "I was partway through parsing a JSON array when I got stuck here:"
120 ,
121 D.stack
122 [ D.reflow $ "I was expecting to see a comma or a closing square bracket next."
123 , D.reflow $
124 "Is a comma missing on the previous line? It is often something like that!"
125 ]
126 )
128 StringProblem stringProblem row col ->
129 case stringProblem of
130 BadStringEnd ->
131 toSnippet "ENDLESS STRING" row col
132 (
133 "I got to the end of the line without seeing the closing double quote:"
134 ,
135 D.fillSep $
136 ["Strings","look","like",D.green "\"this\"","with","double"
137 ,"quotes","on","each","end.","Is","the","closing","double"
138 ,"quote","missing","in","your","code?"
139 ]
140 )
142 BadStringControlChar ->
143 toSnippet "UNEXPECTED CONTROL CHARACTER" row col
144 (
145 "I ran into a control character unexpectedly:"
146 ,
147 D.reflow $
148 "These are characters that represent tabs, backspaces, newlines, and\
149 \ a bunch of other invisible characters. They all come before 20 in the\
150 \ ASCII range, and they are disallowed by the JSON specificaiton. Maybe\
151 \ a copy/paste added one of these invisible characters to your JSON?"
152 )
154 BadStringEscapeChar ->
155 toSnippet "UNKNOWN ESCAPE" row col
156 (
157 "Backslashes always start escaped characters, but I do not recognize this one:"
158 ,
159 D.stack
160 [ D.reflow $
161 "Valid escape characters include:"
162 , D.dullyellow $ D.indent 4 $ D.vcat $
163 ["\\\"","\\\\","\\/","\\b","\\f","\\n","\\r","\\t","\\u003D"]
164 , D.reflow $
165 "Do you want one of those instead? Maybe you need \\\\ to escape a backslash?"
166 ]
167 )
169 BadStringEscapeHex ->
170 toSnippet "BAD HEX ESCAPE" row col
171 (
172 "This is not a valid hex escape:"
173 ,
174 D.fillSep $
175 ["Valid","hex","escapes","in","JSON","are","between"
176 ,D.green "\\u0000","and",D.green "\\uFFFF"
177 ,"and","always","have","exactly","four","digits."
178 ]
179 )
181 NoLeadingZeros row col ->
182 toSnippet "BAD NUMBER" row col
183 (
184 "Numbers cannot start with zeros like this:"
185 ,
186 D.reflow $ "Try deleting the leading zeros?"
187 )
189 NoFloats row col ->
190 toSnippet "UNEXPECTED NUMBER" row col
191 (
192 "I got stuck while trying to parse this number:"
193 ,
194 D.reflow $
195 "I do not accept floating point numbers like 3.1415 right now. That kind\
196 \ of JSON value is not needed for any of the uses that Elm has for now."
197 )
199 BadEnd row col ->
200 toSnippet "JSON PROBLEM" row col
201 (
202 "I was partway through parsing some JSON when I got stuck here:"
203 ,
204 D.reflow $
205 "I am not really sure what is wrong. This sometimes means there is extra\
206 \ stuff after a valid JSON value?"
207 )
210objectNote :: D.Doc
211objectNote =
212 D.stack
213 [ D.toSimpleNote $ "Here is an example of a valid JSON object for reference:"
214 , D.vcat
215 [ D.indent 4 $ "{"
216 , D.indent 6 $ D.dullyellow "\"name\"" <> ": " <> D.dullyellow "\"Tom\"" <> ","
217 , D.indent 6 $ D.dullyellow "\"age\"" <> ": " <> D.dullyellow "42"
218 , D.indent 4 $ "}"
219 ]
220 , D.reflow $
221 "Notice that (1) the field names are in double quotes and (2) there is no\
222 \ trailing comma after the last entry. Both are strict requirements in JSON!"
223 ]
227-- PROBLEM TO REPORT
230data Context
231 = CRoot
232 | CField BS.ByteString Context
233 | CIndex Int Context
236problemToReport :: FilePath -> FailureToReport x -> Code.Source -> Context -> Problem x -> Reason -> Help.Report
237problemToReport path ftr source context problem reason =
238 case problem of
239 Field field prob ->
240 problemToReport path ftr source (CField field context) prob reason
242 Index index prob ->
243 problemToReport path ftr source (CIndex index context) prob reason
245 OneOf p ps ->
246 -- NOTE: only displays the deepest problem. This works well for the kind
247 -- of JSON used by Elm, but probably would not work well in general.
248 let
249 (NE.List prob _) = NE.sortBy (negate . getMaxDepth) (NE.List p ps)
250 in
251 problemToReport path ftr source context prob reason
253 Failure region x ->
254 _failureToReport ftr path source context region x
256 Expecting region expectation ->
257 expectationToReport path source context region expectation reason
260getMaxDepth :: Problem x -> Int
261getMaxDepth problem =
262 case problem of
263 Field _ prob -> 1 + getMaxDepth prob
264 Index _ prob -> 1 + getMaxDepth prob
265 OneOf p ps -> maximum (getMaxDepth p : map getMaxDepth ps)
266 Failure _ _ -> 0
267 Expecting _ _ -> 0
270newtype FailureToReport x =
271 FailureToReport { _failureToReport :: FilePath -> Code.Source -> Context -> A.Region -> x -> Help.Report }
274expectationToReport :: FilePath -> Code.Source -> Context -> A.Region -> DecodeExpectation -> Reason -> Help.Report
275expectationToReport path source context (A.Region start end) expectation reason =
276 let
277 (A.Position sr _) = start
278 (A.Position er _) = end
280 region =
281 if sr == er then region else A.Region start start
283 introduction =
284 case context of
285 CRoot ->
286 "I ran into some trouble here:"
288 CField field _ ->
289 "I ran into trouble with the value of the \"" ++ BS_UTF8.toString field ++ "\" field:"
291 CIndex index (CField field _) ->
292 "When looking at the \"" ++ BS_UTF8.toString field ++ "\" field, I ran into trouble with the "
293 ++ D.intToOrdinal index ++ " entry:"
295 CIndex index _ ->
296 "I ran into trouble with the " ++ D.intToOrdinal index ++ " index of this array:"
298 toSnippet title aThing =
299 Help.jsonReport title (Just path) $
300 Code.toSnippet source region Nothing
301 ( D.reflow (because reason introduction)
302 , D.fillSep $ ["I","was","expecting","to","run","into"] ++ aThing
303 )
304 in
305 case expectation of
306 TObject ->
307 toSnippet "EXPECTING OBJECT" ["an", D.green "OBJECT" <> "."]
309 TArray ->
310 toSnippet "EXPECTING ARRAY" ["an", D.green "ARRAY" <> "."]
312 TString ->
313 toSnippet "EXPECTING STRING" ["a", D.green "STRING" <> "."]
315 TBool ->
316 toSnippet "EXPECTING BOOL" ["a", D.green "BOOLEAN" <> "."]
318 TInt ->
319 toSnippet "EXPECTING INT" ["an", D.green "INT" <> "."]
321 TObjectWith field ->
322 toSnippet "MISSING FIELD"
323 ["an",D.green "OBJECT","with","a"
324 ,D.green ("\"" <> D.fromChars (BS_UTF8.toString field) <> "\"")
325 ,"field."
326 ]
328 TArrayPair len ->
329 toSnippet "EXPECTING PAIR"
330 ["an",D.green "ARRAY","with",D.green "TWO","entries."
331 ,"This","array","has",D.fromInt len, if len == 1 then "element." else "elements."
332 ]