0b89bd8 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Rewrite some parseJSON methods in terms of the new with* functions

0b89bd8Bas van Dijk14 years ago

Data/Aeson/Types/Class.hs+55−68

compare with master

unifiedsplit

@@ -236,8 +236,7 @@ instance ToJSON Bool where

236 {-# INLINE toJSON #-}

237

238instance FromJSON Bool where

239− parseJSON (Bool b) = pure b

239+ parseJSON = withBool "Bool" pure

240− parseJSON v = typeMismatch "Bool" v

241 {-# INLINE parseJSON #-}

240 {-# INLINE parseJSON #-}

242

241

243instance ToJSON () where

242instance ToJSON () where

@@ -245,8 +244,10 @@ instance ToJSON () where

245 {-# INLINE toJSON #-}

244 {-# INLINE toJSON #-}

246

245

247instance FromJSON () where

246instance FromJSON () where

248− parseJSON (Array v) | V.null v = pure ()

247+ parseJSON = withArray "()" $ \v ->

249− parseJSON v = typeMismatch "()" v

248+ if V.null v

249+ then pure ()

250+ else fail "Expected an empty array"

250 {-# INLINE parseJSON #-}

251 {-# INLINE parseJSON #-}

251

252

252instance ToJSON [Char] where

253instance ToJSON [Char] where

@@ -254,8 +255,7 @@ instance ToJSON [Char] where

254 {-# INLINE toJSON #-}

255 {-# INLINE toJSON #-}

255

256

256instance FromJSON [Char] where

257instance FromJSON [Char] where

257− parseJSON (String t) = pure (T.unpack t)

258+ parseJSON = withText "String" $ pure . T.unpack

258− parseJSON v = typeMismatch "String" v

259 {-# INLINE parseJSON #-}

260

261instance ToJSON Char where

@@ -263,9 +263,10 @@ instance ToJSON Char where

263 {-# INLINE toJSON #-}

264

265instance FromJSON Char where

266− parseJSON (String t)

266+ parseJSON = withText "Char" $ \t ->

267− | T.compareLength t 1 == EQ = pure (T.head t)

267+ if T.compareLength t 1 == EQ

268− parseJSON v = typeMismatch "Char" v

268+ then pure $ T.head t

269+ else fail "Expected a string of length 1"

269 {-# INLINE parseJSON #-}

270 {-# INLINE parseJSON #-}

270

271

271instance ToJSON Double where

272instance ToJSON Double where

@@ -307,10 +308,10 @@ instance ToJSON (Ratio Integer) where

307 {-# INLINE toJSON #-}

308 {-# INLINE toJSON #-}

308

309

309instance FromJSON (Ratio Integer) where

310instance FromJSON (Ratio Integer) where

311+ parseJSON = withNumber "Ration Integer" $ \n ->

310− parseJSON (Number n) = pure $ case n of

312+ pure $ case n of

311− D d -> toRational d

313+ D d -> toRational d

312− I i -> fromIntegral i

314+ I i -> fromIntegral i

313− parseJSON v = typeMismatch "Ratio Integer" v

314 {-# INLINE parseJSON #-}

315 {-# INLINE parseJSON #-}

315

316

316instance ToJSON Int where

317instance ToJSON Int where

@@ -322,8 +323,7 @@ instance FromJSON Int where

322 {-# INLINE parseJSON #-}

323 {-# INLINE parseJSON #-}

323

324

324parseIntegral :: Integral a => Value -> Parser a

325parseIntegral :: Integral a => Value -> Parser a

325−parseIntegral (Number n) = pure (floor n)

326+parseIntegral = withNumber "Integral" $ pure . floor

326−parseIntegral v = typeMismatch "Integral" v

327{-# INLINE parseIntegral #-}

328

329instance ToJSON Integer where

@@ -411,8 +411,7 @@ instance ToJSON Text where

411 {-# INLINE toJSON #-}

412

413instance FromJSON Text where

414− parseJSON (String t) = pure t

414+ parseJSON = withText "Text" pure

415− parseJSON v = typeMismatch "Text" v

416 {-# INLINE parseJSON #-}

415 {-# INLINE parseJSON #-}

417

416

418instance ToJSON LT.Text where

417instance ToJSON LT.Text where

@@ -420,8 +419,7 @@ instance ToJSON LT.Text where

420 {-# INLINE toJSON #-}

419 {-# INLINE toJSON #-}

421

420

422instance FromJSON LT.Text where

421instance FromJSON LT.Text where

423− parseJSON (String t) = pure (LT.fromStrict t)

422+ parseJSON = withText "Lazy Text" $ pure . LT.fromStrict

424− parseJSON v = typeMismatch "Lazy Text" v

425 {-# INLINE parseJSON #-}

423 {-# INLINE parseJSON #-}

426

424

427instance ToJSON B.ByteString where

425instance ToJSON B.ByteString where

@@ -429,8 +427,7 @@ instance ToJSON B.ByteString where

429 {-# INLINE toJSON #-}

427 {-# INLINE toJSON #-}

430

428

431instance FromJSON B.ByteString where

429instance FromJSON B.ByteString where

432− parseJSON (String t) = pure . encodeUtf8 $ t

430+ parseJSON = withText "ByteString" $ pure . encodeUtf8

433− parseJSON v = typeMismatch "ByteString" v

434 {-# INLINE parseJSON #-}

431 {-# INLINE parseJSON #-}

435

432

436instance ToJSON LB.ByteString where

433instance ToJSON LB.ByteString where

@@ -438,8 +435,7 @@ instance ToJSON LB.ByteString where

438 {-# INLINE toJSON #-}

435 {-# INLINE toJSON #-}

439

436

440instance FromJSON LB.ByteString where

437instance FromJSON LB.ByteString where

441− parseJSON (String t) = pure . lazy $ t

438+ parseJSON = withText "Lazy ByteString" $ pure . lazy

442− parseJSON v = typeMismatch "Lazy ByteString" v

443 {-# INLINE parseJSON #-}

439 {-# INLINE parseJSON #-}

444

440

445instance (ToJSON a) => ToJSON [a] where

441instance (ToJSON a) => ToJSON [a] where

@@ -447,8 +443,7 @@ instance (ToJSON a) => ToJSON [a] where

447 {-# INLINE toJSON #-}

443 {-# INLINE toJSON #-}

448

444

449instance (FromJSON a) => FromJSON [a] where

445instance (FromJSON a) => FromJSON [a] where

450− parseJSON (Array a) = mapM parseJSON (V.toList a)

446+ parseJSON = withArray "[a]" $ mapM parseJSON . V.toList

451− parseJSON v = typeMismatch "[a]" v

452 {-# INLINE parseJSON #-}

447 {-# INLINE parseJSON #-}

453

448

454instance (ToJSON a) => ToJSON (Vector a) where

449instance (ToJSON a) => ToJSON (Vector a) where

@@ -456,8 +451,7 @@ instance (ToJSON a) => ToJSON (Vector a) where

456 {-# INLINE toJSON #-}

451 {-# INLINE toJSON #-}

457

452

458instance (FromJSON a) => FromJSON (Vector a) where

453instance (FromJSON a) => FromJSON (Vector a) where

459− parseJSON (Array a) = V.mapM parseJSON a

454+ parseJSON = withArray "Vector a" $ V.mapM parseJSON

460− parseJSON v = typeMismatch "Vector a" v

461 {-# INLINE parseJSON #-}

455 {-# INLINE parseJSON #-}

462

456

463vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value

457vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value

@@ -465,8 +459,7 @@ vectorToJSON = Array . V.map toJSON . V.convert

465{-# INLINE vectorToJSON #-}

459{-# INLINE vectorToJSON #-}

466

460

467vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)

461vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)

468−vectorParseJSON _ (Array a) = V.convert <$> V.mapM parseJSON a

462+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON

469−vectorParseJSON s v = typeMismatch s v

470{-# INLINE vectorParseJSON #-}

463{-# INLINE vectorParseJSON #-}

471

464

472instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where

465instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where

@@ -524,8 +517,8 @@ instance (ToJSON v) => ToJSON (M.Map Text v) where

524 {-# INLINE toJSON #-}

517 {-# INLINE toJSON #-}

525

518

526instance (FromJSON v) => FromJSON (M.Map Text v) where

519instance (FromJSON v) => FromJSON (M.Map Text v) where

520+ parseJSON = withObject "Map Text a" $

527− parseJSON (Object o) = H.foldrWithKey M.insert M.empty <$> traverse parseJSON o

521+ fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON

528− parseJSON v = typeMismatch "Map Text a" v

529

522

530instance (ToJSON v) => ToJSON (M.Map LT.Text v) where

523instance (ToJSON v) => ToJSON (M.Map LT.Text v) where

531 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

524 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

@@ -556,8 +549,7 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where

556 {-# INLINE toJSON #-}

549 {-# INLINE toJSON #-}

557

550

558instance (FromJSON v) => FromJSON (H.HashMap Text v) where

551instance (FromJSON v) => FromJSON (H.HashMap Text v) where

559− parseJSON (Object o) = traverse parseJSON o

552+ parseJSON = withObject "HashMap Text a" $ traverse parseJSON

560− parseJSON v = typeMismatch "HashMap Text a" v

561

553

562instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

554instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

563 toJSON = Object . mapKeyVal LT.toStrict toJSON

555 toJSON = Object . mapKeyVal LT.toStrict toJSON

@@ -610,13 +602,12 @@ instance ToJSON DotNetTime where

610 {-# INLINE toJSON #-}

602 {-# INLINE toJSON #-}

611

603

612instance FromJSON DotNetTime where

604instance FromJSON DotNetTime where

613− parseJSON (String t) =

605+ parseJSON = withText "DotNetTime" $ \t ->

614− case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of

615− Just d -> pure (DotNetTime d)

616− _ -> fail "could not parse .NET time"

617− where (s,m) = T.splitAt (T.length t - 5) t

606+ let (s,m) = T.splitAt (T.length t - 5) t

618 t' = T.concat [s,".",m]

607 t' = T.concat [s,".",m]

619− parseJSON v = typeMismatch "DotNetTime" v

608+ in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of

609+ Just d -> pure (DotNetTime d)

610+ _ -> fail "could not parse .NET time"

620 {-# INLINE parseJSON #-}

611 {-# INLINE parseJSON #-}

621

612

622instance ToJSON UTCTime where

613instance ToJSON UTCTime where

@@ -625,11 +616,10 @@ instance ToJSON UTCTime where

625 {-# INLINE toJSON #-}

616 {-# INLINE toJSON #-}

626

617

627instance FromJSON UTCTime where

618instance FromJSON UTCTime where

628− parseJSON (String t) =

619+ parseJSON = withText "UTCTime" $ \t ->

629 case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of

620 case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of

630 Just d -> pure d

621 Just d -> pure d

631 _ -> fail "could not parse ISO-8601 date"

622 _ -> fail "could not parse ISO-8601 date"

632− parseJSON v = typeMismatch "UTCTime" v

633 {-# INLINE parseJSON #-}

623 {-# INLINE parseJSON #-}

634

624

635instance (ToJSON a, ToJSON b) => ToJSON (a,b) where

625instance (ToJSON a, ToJSON b) => ToJSON (a,b) where

@@ -641,14 +631,13 @@ instance (ToJSON a, ToJSON b) => ToJSON (a,b) where

641 {-# INLINE toJSON #-}

631 {-# INLINE toJSON #-}

642

632

643instance (FromJSON a, FromJSON b) => FromJSON (a,b) where

633instance (FromJSON a, FromJSON b) => FromJSON (a,b) where

644− parseJSON (Array ab)

634+ parseJSON = withArray "(a,b)" $ \ab ->

635+ let n = V.length ab

636+ in if n == 2

645− | n == 2 = (,) <$> parseJSON (V.unsafeIndex ab 0)

637+ then (,) <$> parseJSON (V.unsafeIndex ab 0)

646− <*> parseJSON (V.unsafeIndex ab 1)

638+ <*> parseJSON (V.unsafeIndex ab 1)

647− | otherwise = fail $ "cannot unpack array of length " ++

639+ else fail $ "cannot unpack array of length " ++

648− show n ++ " into a pair"

640+ show n ++ " into a pair"

649− where

650− n = V.length ab

651− parseJSON v = typeMismatch "(a,b)" v

652 {-# INLINE parseJSON #-}

641 {-# INLINE parseJSON #-}

653

642

654instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where

643instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where

@@ -661,15 +650,14 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where

661 {-# INLINE toJSON #-}

650 {-# INLINE toJSON #-}

662

651

663instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where

652instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where

664− parseJSON (Array abc)

653+ parseJSON = withArray "(a,b,c)" $ \abc ->

654+ let n = V.length abc

655+ in if n == 3

665− | n == 3 = (,,) <$> parseJSON (V.unsafeIndex abc 0)

656+ then (,,) <$> parseJSON (V.unsafeIndex abc 0)

666− <*> parseJSON (V.unsafeIndex abc 1)

657+ <*> parseJSON (V.unsafeIndex abc 1)

667− <*> parseJSON (V.unsafeIndex abc 2)

658+ <*> parseJSON (V.unsafeIndex abc 2)

668− | otherwise = fail $ "cannot unpack array of length " ++

659+ else fail $ "cannot unpack array of length " ++

669− show n ++ " into a 3-tuple"

660+ show n ++ " into a 3-tuple"

670− where

671− n = V.length abc

672− parseJSON v = typeMismatch "(a,b,c)" v

673 {-# INLINE parseJSON #-}

661 {-# INLINE parseJSON #-}

674

662

675instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where

663instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where

@@ -683,16 +671,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where

683 {-# INLINE toJSON #-}

671 {-# INLINE toJSON #-}

684

672

685instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where

673instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where

686− parseJSON (Array abcd)

674+ parseJSON = withArray "(a,b,c,d)" $ \abcd ->

675+ let n = V.length abcd

676+ in if n == 4

687− | n == 4 = (,,,) <$> parseJSON (V.unsafeIndex abcd 0)

677+ then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)

688− <*> parseJSON (V.unsafeIndex abcd 1)

678+ <*> parseJSON (V.unsafeIndex abcd 1)

689− <*> parseJSON (V.unsafeIndex abcd 2)

679+ <*> parseJSON (V.unsafeIndex abcd 2)

690− <*> parseJSON (V.unsafeIndex abcd 3)

680+ <*> parseJSON (V.unsafeIndex abcd 3)

691− | otherwise = fail $ "cannot unpack array of length " ++

681+ else fail $ "cannot unpack array of length " ++

692− show n ++ " into a 4-tuple"

682+ show n ++ " into a 4-tuple"

693− where

694− n = V.length abcd

695− parseJSON v = typeMismatch "(a,b,c,d)" v

696 {-# INLINE parseJSON #-}

683 {-# INLINE parseJSON #-}

697

684

698instance ToJSON a => ToJSON (Dual a) where

685instance ToJSON a => ToJSON (Dual a) where