on master help sign in
add region tracking to the JSON parser
commitca88bacc738fca975d73474b4f5854a560987558 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 12 Jun 2019, 14:21 (7 years ago) parent4619b49
1 file changed+46−35
compiler/src/Json/Decode.hs+46−35
compiler/src/Json/Decode.hs+46−35
@@ -40,6 +40,7 @@ import qualified Json.String as Json
4040import qualified Parse.Keyword as K
4141import qualified Parse.Primitives as P
4242import Parse.Primitives (Row, Col)
43+import qualified Reporting.Annotation as A
4344
4445
4546
@@ -88,8 +89,8 @@ data Problem x
8889 = Field B.ByteString (Problem x)
8990 | Index Int (Problem x)
9091 | OneOf (Problem x) [Problem x]
91− | Failure x
92− | Expecting DecodeExpectation
92+ | Failure A.Region x
93+ | Expecting A.Region DecodeExpectation
9394
9495
9596data DecodeExpectation
@@ -156,26 +157,26 @@ instance Monad (Decoder x) where
156157
157158string :: Decoder x Json.String
158159string =
159− Decoder $ \ast ok err ->
160+ Decoder $ \(A.At region ast) ok err ->
160161 case ast of
161162 String snippet ->
162163 ok (Json.fromSnippet snippet)
163164
164165 _ ->
165− err (Expecting TString)
166+ err (Expecting region TString)
166167
167168
168169customString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a
169170customString parser toBadEnd =
170− Decoder $ \ast ok err ->
171+ Decoder $ \(A.At region ast) ok err ->
171172 case ast of
172173 String snippet ->
173174 case P.fromSnippet parser toBadEnd snippet of
174175 Right a -> ok a
175− Left x -> err (Failure x)
176+ Left x -> err (Failure region x)
176177
177178 _ ->
178− err (Expecting TString)
179+ err (Expecting region TString)
179180
180181
181182
@@ -184,7 +185,7 @@ customString parser toBadEnd =
184185
185186bool :: Decoder x Bool
186187bool =
187− Decoder $ \ast ok err ->
188+ Decoder $ \(A.At region ast) ok err ->
188189 case ast of
189190 TRUE ->
190191 ok True
@@ -193,7 +194,7 @@ bool =
193194 ok False
194195
195196 _ ->
196− err (Expecting TBool)
197+ err (Expecting region TBool)
197198
198199
199200
@@ -202,13 +203,13 @@ bool =
202203
203204int :: Decoder x Int
204205int =
205− Decoder $ \ast ok err ->
206+ Decoder $ \(A.At region ast) ok err ->
206207 case ast of
207208 Int n ->
208209 ok n
209210
210211 _ ->
211− err (Expecting TInt)
212+ err (Expecting region TInt)
212213
213214
214215
@@ -217,13 +218,13 @@ int =
217218
218219list :: Decoder x a -> Decoder x [a]
219220list decoder =
220− Decoder $ \ast ok err ->
221+ Decoder $ \(A.At region ast) ok err ->
221222 case ast of
222223 Array asts ->
223224 listHelp decoder ok err 0 asts []
224225
225226 _ ->
226− err (Expecting TArray)
227+ err (Expecting region TArray)
227228
228229
229230listHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b
@@ -258,7 +259,7 @@ nonEmptyList decoder x =
258259
259260pair :: Decoder x a -> Decoder x b -> Decoder x (a,b)
260261pair (Decoder decodeA) (Decoder decodeB) =
261− Decoder $ \ast ok err ->
262+ Decoder $ \(A.At region ast) ok err ->
262263 case ast of
263264 Array vs ->
264265 case vs of
@@ -275,10 +276,10 @@ pair (Decoder decodeA) (Decoder decodeB) =
275276 decodeA astA ok0 err0
276277
277278 _ ->
278− err (Expecting (TArrayPair (length vs)))
279+ err (Expecting region (TArrayPair (length vs)))
279280
280281 _ ->
281− err (Expecting TArray)
282+ err (Expecting region TArray)
282283
283284
284285
@@ -296,13 +297,13 @@ dict keyDecoder valueDecoder =
296297
297298pairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]
298299pairs keyDecoder valueDecoder =
299− Decoder $ \ast ok err ->
300+ Decoder $ \(A.At region ast) ok err ->
300301 case ast of
301302 Object kvs ->
302303 pairsHelp keyDecoder valueDecoder ok err kvs []
303304
304305 _ ->
305− err (Expecting TObject)
306+ err (Expecting region TObject)
306307
307308
308309pairsHelp :: KeyDecoder x k -> Decoder x a -> ([(k, a)] -> b) -> (Problem x -> b) -> [(P.Snippet, AST)] -> [(k, a)] -> b
@@ -314,7 +315,7 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod
314315 (snippet, ast) : kvs ->
315316 case P.fromSnippet keyParser toBadEnd snippet of
316317 Left x ->
317− err (Failure x)
318+ err (Failure (snippetToRegion snippet) x)
318319
319320 Right key ->
320321 let
@@ -326,13 +327,18 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod
326327 decodeA ast ok' err'
327328
328329
330+snippetToRegion :: P.Snippet -> A.Region
331+snippetToRegion (P.Snippet _ _ len row col) =
332+ A.Region (A.Position row col) (A.Position row (col + fromIntegral len))
333+
334+
329335
330336-- FIELDS
331337
332338
333339field :: B.ByteString -> Decoder x a -> Decoder x a
334340field key (Decoder decodeA) =
335− Decoder $ \ast ok err ->
341+ Decoder $ \(A.At region ast) ok err ->
336342 case ast of
337343 Object kvs ->
338344 case findField key kvs of
@@ -344,10 +350,10 @@ field key (Decoder decodeA) =
344350 decodeA value ok err'
345351
346352 Nothing ->
347− err (Expecting (TObjectWith key))
353+ err (Expecting region (TObjectWith key))
348354
349355 _ ->
350− err (Expecting TObject)
356+ err (Expecting region TObject)
351357
352358
353359findField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST
@@ -411,8 +417,8 @@ oneOfError problems prob ps =
411417
412418failure :: x -> Decoder x a
413419failure x =
414− Decoder $ \_ _ err ->
415− err (Failure x)
420+ Decoder $ \(A.At region _) _ err ->
421+ err (Failure region x)
416422
417423
418424
@@ -431,18 +437,22 @@ mapError func (Decoder decodeA) =
431437mapErrorHelp :: (x -> y) -> Problem x -> Problem y
432438mapErrorHelp func problem =
433439 case problem of
434− Field k p -> Field k (mapErrorHelp func p)
435− Index i p -> Index i (mapErrorHelp func p)
436− OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)
437− Failure x -> Failure (func x)
438− Expecting e -> Expecting e
440+ Field k p -> Field k (mapErrorHelp func p)
441+ Index i p -> Index i (mapErrorHelp func p)
442+ OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)
443+ Failure r x -> Failure r (func x)
444+ Expecting r e -> Expecting r e
439445
440446
441447
442448-- AST
443449
444450
445−data AST
451+type AST =
452+ A.Located AST_
453+
454+
455+data AST_
446456 = Array [AST]
447457 | Object [(P.Snippet, AST)]
448458 | String P.Snippet
@@ -496,6 +506,7 @@ pFile =
496506
497507pValue :: Parser AST
498508pValue =
509+ P.addLocation $
499510 P.oneOf Start
500511 [ String <$> pString Start
501512 , pObject
@@ -511,7 +522,7 @@ pValue =
511522-- OBJECT
512523
513524
514−pObject :: Parser AST
525+pObject :: Parser AST_
515526pObject =
516527 do P.word1 0x7B {- { -} Start
517528 spaces
@@ -524,7 +535,7 @@ pObject =
524535 ]
525536
526537
527−pObjectHelp :: [(P.Snippet, AST)] -> Parser AST
538+pObjectHelp :: [(P.Snippet, AST)] -> Parser AST_
528539pObjectHelp revEntries =
529540 P.oneOf ObjectEnd
530541 [
@@ -553,7 +564,7 @@ pField =
553564-- ARRAY
554565
555566
556−pArray :: Parser AST
567+pArray :: Parser AST_
557568pArray =
558569 do P.word1 0x5B {-[-} Start
559570 spaces
@@ -566,7 +577,7 @@ pArray =
566577 ]
567578
568579
569−pArrayHelp :: Int -> [AST] -> Parser AST
580+pArrayHelp :: Int -> [AST] -> Parser AST_
570581pArrayHelp !len revEntries =
571582 P.oneOf ArrayEnd
572583 [
@@ -716,7 +727,7 @@ eatSpaces pos end row col =
716727-- INTS
717728
718729
719−pInt :: Parser AST
730+pInt :: Parser AST_
720731pInt =
721732 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
722733 if pos >= end then