ca88bac · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

add region tracking to the JSON parser

ca88bacEvan Czaplicki7 years ago

compiler/src/Json/Decode.hs+46−35

compare with master

unifiedsplit

@@ -40,6 +40,7 @@ import qualified Json.String as Json

40import qualified Parse.Keyword as K

41import qualified Parse.Primitives as P

42import Parse.Primitives (Row, Col)

43+import qualified Reporting.Annotation as A

@@ -88,8 +89,8 @@ data Problem x

88 = Field B.ByteString (Problem x)

89 = Field B.ByteString (Problem x)

89 | Index Int (Problem x)

90 | Index Int (Problem x)

90 | OneOf (Problem x) [Problem x]

91 | OneOf (Problem x) [Problem x]

91− | Failure x

92+ | Failure A.Region x

92− | Expecting DecodeExpectation

93+ | Expecting A.Region DecodeExpectation

95data DecodeExpectation

96data DecodeExpectation

@@ -156,26 +157,26 @@ instance Monad (Decoder x) where

156

157

157string :: Decoder x Json.String

158string :: Decoder x Json.String

158string =

159string =

159− Decoder $ \ast ok err ->

160+ Decoder $ \(A.At region ast) ok err ->

160 case ast of

161 case ast of

161 String snippet ->

162 String snippet ->

162 ok (Json.fromSnippet snippet)

163 ok (Json.fromSnippet snippet)

163

164

164 _ ->

165 _ ->

165− err (Expecting TString)

166+ err (Expecting region TString)

166

167

168

168customString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a

169customString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a

169customString parser toBadEnd =

170customString parser toBadEnd =

170− Decoder $ \ast ok err ->

171+ Decoder $ \(A.At region ast) ok err ->

171 case ast of

172 case ast of

172 String snippet ->

173 String snippet ->

173 case P.fromSnippet parser toBadEnd snippet of

174 case P.fromSnippet parser toBadEnd snippet of

174 Right a -> ok a

175 Right a -> ok a

175− Left x -> err (Failure x)

176+ Left x -> err (Failure region x)

176

177

177 _ ->

178 _ ->

178− err (Expecting TString)

179+ err (Expecting region TString)

179

180

181

182

@@ -184,7 +185,7 @@ customString parser toBadEnd =

184

185

185bool :: Decoder x Bool

186bool :: Decoder x Bool

186bool =

187bool =

187− Decoder $ \ast ok err ->

188+ Decoder $ \(A.At region ast) ok err ->

188 case ast of

189 case ast of

189 TRUE ->

190 TRUE ->

190 ok True

191 ok True

@@ -193,7 +194,7 @@ bool =

193 ok False

194 ok False

194

195

195 _ ->

196 _ ->

196− err (Expecting TBool)

197+ err (Expecting region TBool)

197

198

199

200

@@ -202,13 +203,13 @@ bool =

202

203

203int :: Decoder x Int

204int :: Decoder x Int

204int =

205int =

205− Decoder $ \ast ok err ->

206+ Decoder $ \(A.At region ast) ok err ->

206 case ast of

207 case ast of

207 Int n ->

208 Int n ->

208 ok n

209 ok n

209

210

210 _ ->

211 _ ->

211− err (Expecting TInt)

212+ err (Expecting region TInt)

212

213

214

215

@@ -217,13 +218,13 @@ int =

217

218

218list :: Decoder x a -> Decoder x [a]

219list :: Decoder x a -> Decoder x [a]

219list decoder =

220list decoder =

220− Decoder $ \ast ok err ->

221+ Decoder $ \(A.At region ast) ok err ->

221 case ast of

222 case ast of

222 Array asts ->

223 Array asts ->

223 listHelp decoder ok err 0 asts []

224 listHelp decoder ok err 0 asts []

224

225

225 _ ->

226 _ ->

226− err (Expecting TArray)

227+ err (Expecting region TArray)

227

228

229

229listHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b

230listHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b

@@ -258,7 +259,7 @@ nonEmptyList decoder x =

258

259

259pair :: Decoder x a -> Decoder x b -> Decoder x (a,b)

260pair :: Decoder x a -> Decoder x b -> Decoder x (a,b)

260pair (Decoder decodeA) (Decoder decodeB) =

261pair (Decoder decodeA) (Decoder decodeB) =

261− Decoder $ \ast ok err ->

262+ Decoder $ \(A.At region ast) ok err ->

262 case ast of

263 case ast of

263 Array vs ->

264 Array vs ->

264 case vs of

265 case vs of

@@ -275,10 +276,10 @@ pair (Decoder decodeA) (Decoder decodeB) =

275 decodeA astA ok0 err0

276 decodeA astA ok0 err0

276

277

277 _ ->

278 _ ->

278− err (Expecting (TArrayPair (length vs)))

279+ err (Expecting region (TArrayPair (length vs)))

279

280

280 _ ->

281 _ ->

281− err (Expecting TArray)

282+ err (Expecting region TArray)

282

283

284

285

@@ -296,13 +297,13 @@ dict keyDecoder valueDecoder =

296

297

297pairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]

298pairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]

298pairs keyDecoder valueDecoder =

299pairs keyDecoder valueDecoder =

299− Decoder $ \ast ok err ->

300+ Decoder $ \(A.At region ast) ok err ->

300 case ast of

301 case ast of

301 Object kvs ->

302 Object kvs ->

302 pairsHelp keyDecoder valueDecoder ok err kvs []

303 pairsHelp keyDecoder valueDecoder ok err kvs []

303

304

304 _ ->

305 _ ->

305− err (Expecting TObject)

306+ err (Expecting region TObject)

306

307

308

308pairsHelp :: KeyDecoder x k -> Decoder x a -> ([(k, a)] -> b) -> (Problem x -> b) -> [(P.Snippet, AST)] -> [(k, a)] -> b

309pairsHelp :: 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

314 (snippet, ast) : kvs ->

315 (snippet, ast) : kvs ->

315 case P.fromSnippet keyParser toBadEnd snippet of

316 case P.fromSnippet keyParser toBadEnd snippet of

316 Left x ->

317 Left x ->

317− err (Failure x)

318+ err (Failure (snippetToRegion snippet) x)

318

319

319 Right key ->

320 Right key ->

320 let

321 let

@@ -326,13 +327,18 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod

326 decodeA ast ok' err'

327 decodeA ast ok' err'

327

328

329

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+

329

335

330-- FIELDS

336-- FIELDS

331

337

332

338

333field :: B.ByteString -> Decoder x a -> Decoder x a

339field :: B.ByteString -> Decoder x a -> Decoder x a

334field key (Decoder decodeA) =

340field key (Decoder decodeA) =

335− Decoder $ \ast ok err ->

341+ Decoder $ \(A.At region ast) ok err ->

336 case ast of

342 case ast of

337 Object kvs ->

343 Object kvs ->

338 case findField key kvs of

344 case findField key kvs of

@@ -344,10 +350,10 @@ field key (Decoder decodeA) =

344 decodeA value ok err'

350 decodeA value ok err'

345

351

346 Nothing ->

352 Nothing ->

347− err (Expecting (TObjectWith key))

353+ err (Expecting region (TObjectWith key))

348

354

349 _ ->

355 _ ->

350− err (Expecting TObject)

356+ err (Expecting region TObject)

351

357

352

358

353findField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST

359findField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST

@@ -411,8 +417,8 @@ oneOfError problems prob ps =

411

417

412failure :: x -> Decoder x a

418failure :: x -> Decoder x a

413failure x =

419failure x =

414− Decoder $ \_ _ err ->

420+ Decoder $ \(A.At region _) _ err ->

415− err (Failure x)

421+ err (Failure region x)

416

422

417

423

418

424

@@ -431,18 +437,22 @@ mapError func (Decoder decodeA) =

431mapErrorHelp :: (x -> y) -> Problem x -> Problem y

437mapErrorHelp :: (x -> y) -> Problem x -> Problem y

432mapErrorHelp func problem =

438mapErrorHelp func problem =

433 case problem of

439 case problem of

434− Field k p -> Field k (mapErrorHelp func p)

440+ Field k p -> Field k (mapErrorHelp func p)

435− Index i p -> Index i (mapErrorHelp func p)

441+ Index i p -> Index i (mapErrorHelp func p)

436− OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)

442+ OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)

437− Failure x -> Failure (func x)

443+ Failure r x -> Failure r (func x)

438− Expecting e -> Expecting e

444+ Expecting r e -> Expecting r e

439

445

440

446

441

447

442-- AST

448-- AST

443

449

444

450

445−data AST

451+type AST =

452+ A.Located AST_

453+

454+

455+data AST_

446 = Array [AST]

456 = Array [AST]

447 | Object [(P.Snippet, AST)]

457 | Object [(P.Snippet, AST)]

448 | String P.Snippet

458 | String P.Snippet

@@ -496,6 +506,7 @@ pFile =

496

506

497pValue :: Parser AST

507pValue :: Parser AST

498pValue =

508pValue =

509+ P.addLocation $

499 P.oneOf Start

510 P.oneOf Start

500 [ String <$> pString Start

511 [ String <$> pString Start

501 , pObject

512 , pObject

@@ -511,7 +522,7 @@ pValue =

511-- OBJECT

522-- OBJECT

512

523

513

524

514−pObject :: Parser AST

525+pObject :: Parser AST_

515pObject =

526pObject =

516 do P.word1 0x7B {- { -} Start

527 do P.word1 0x7B {- { -} Start

517 spaces

528 spaces

@@ -524,7 +535,7 @@ pObject =

524 ]

535 ]

525

536

526

537

527−pObjectHelp :: [(P.Snippet, AST)] -> Parser AST

538+pObjectHelp :: [(P.Snippet, AST)] -> Parser AST_

528pObjectHelp revEntries =

539pObjectHelp revEntries =

529 P.oneOf ObjectEnd

540 P.oneOf ObjectEnd

530 [

541 [

@@ -553,7 +564,7 @@ pField =

553-- ARRAY

564-- ARRAY

554

565

555

566

556−pArray :: Parser AST

567+pArray :: Parser AST_

557pArray =

568pArray =

558 do P.word1 0x5B {-[-} Start

569 do P.word1 0x5B {-[-} Start

559 spaces

570 spaces

@@ -566,7 +577,7 @@ pArray =

566 ]

577 ]

567

578

568

579

569−pArrayHelp :: Int -> [AST] -> Parser AST

580+pArrayHelp :: Int -> [AST] -> Parser AST_

570pArrayHelp !len revEntries =

581pArrayHelp !len revEntries =

571 P.oneOf ArrayEnd

582 P.oneOf ArrayEnd

572 [

583 [

@@ -716,7 +727,7 @@ eatSpaces pos end row col =

716-- INTS

727-- INTS

717

728

718

729

719−pInt :: Parser AST

730+pInt :: Parser AST_

720pInt =

731pInt =

721 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

732 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

722 if pos >= end then

733 if pos >= end then