@@ -236,8 +236,7 @@ instance ToJSON Bool where
236236 {-# INLINE toJSON #-}
237237
238238instance FromJSON Bool where
239− parseJSON (Bool b) = pure b
240− parseJSON v = typeMismatch "Bool" v
239+ parseJSON = withBool "Bool" pure
241240 {-# INLINE parseJSON #-}
242241
243242instance ToJSON () where
@@ -245,8 +244,10 @@ instance ToJSON () where
245244 {-# INLINE toJSON #-}
246245
247246instance FromJSON () where
248− parseJSON (Array v) | V.null v = pure ()
249− parseJSON v = typeMismatch "()" v
247+ parseJSON = withArray "()" $ \v ->
248+ if V.null v
249+ then pure ()
250+ else fail "Expected an empty array"
250251 {-# INLINE parseJSON #-}
251252
252253instance ToJSON [Char] where
@@ -254,8 +255,7 @@ instance ToJSON [Char] where
254255 {-# INLINE toJSON #-}
255256
256257instance FromJSON [Char] where
257− parseJSON (String t) = pure (T.unpack t)
258− parseJSON v = typeMismatch "String" v
258+ parseJSON = withText "String" $ pure . T.unpack
259259 {-# INLINE parseJSON #-}
260260
261261instance ToJSON Char where
@@ -263,9 +263,10 @@ instance ToJSON Char where
263263 {-# INLINE toJSON #-}
264264
265265instance FromJSON Char where
266− parseJSON (String t)
267− | T.compareLength t 1 == EQ = pure (T.head t)
268− parseJSON v = typeMismatch "Char" v
266+ parseJSON = withText "Char" $ \t ->
267+ if T.compareLength t 1 == EQ
268+ then pure $ T.head t
269+ else fail "Expected a string of length 1"
269270 {-# INLINE parseJSON #-}
270271
271272instance ToJSON Double where
@@ -307,10 +308,10 @@ instance ToJSON (Ratio Integer) where
307308 {-# INLINE toJSON #-}
308309
309310instance FromJSON (Ratio Integer) where
310− parseJSON (Number n) = pure $ case n of
311− D d -> toRational d
312− I i -> fromIntegral i
313− parseJSON v = typeMismatch "Ratio Integer" v
311+ parseJSON = withNumber "Ration Integer" $ \n ->
312+ pure $ case n of
313+ D d -> toRational d
314+ I i -> fromIntegral i
314315 {-# INLINE parseJSON #-}
315316
316317instance ToJSON Int where
@@ -322,8 +323,7 @@ instance FromJSON Int where
322323 {-# INLINE parseJSON #-}
323324
324325parseIntegral :: Integral a => Value -> Parser a
325−parseIntegral (Number n) = pure (floor n)
326−parseIntegral v = typeMismatch "Integral" v
326+parseIntegral = withNumber "Integral" $ pure . floor
327327{-# INLINE parseIntegral #-}
328328
329329instance ToJSON Integer where
@@ -411,8 +411,7 @@ instance ToJSON Text where
411411 {-# INLINE toJSON #-}
412412
413413instance FromJSON Text where
414− parseJSON (String t) = pure t
415− parseJSON v = typeMismatch "Text" v
414+ parseJSON = withText "Text" pure
416415 {-# INLINE parseJSON #-}
417416
418417instance ToJSON LT.Text where
@@ -420,8 +419,7 @@ instance ToJSON LT.Text where
420419 {-# INLINE toJSON #-}
421420
422421instance FromJSON LT.Text where
423− parseJSON (String t) = pure (LT.fromStrict t)
424− parseJSON v = typeMismatch "Lazy Text" v
422+ parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
425423 {-# INLINE parseJSON #-}
426424
427425instance ToJSON B.ByteString where
@@ -429,8 +427,7 @@ instance ToJSON B.ByteString where
429427 {-# INLINE toJSON #-}
430428
431429instance FromJSON B.ByteString where
432− parseJSON (String t) = pure . encodeUtf8 $ t
433− parseJSON v = typeMismatch "ByteString" v
430+ parseJSON = withText "ByteString" $ pure . encodeUtf8
434431 {-# INLINE parseJSON #-}
435432
436433instance ToJSON LB.ByteString where
@@ -438,8 +435,7 @@ instance ToJSON LB.ByteString where
438435 {-# INLINE toJSON #-}
439436
440437instance FromJSON LB.ByteString where
441− parseJSON (String t) = pure . lazy $ t
442− parseJSON v = typeMismatch "Lazy ByteString" v
438+ parseJSON = withText "Lazy ByteString" $ pure . lazy
443439 {-# INLINE parseJSON #-}
444440
445441instance (ToJSON a) => ToJSON [a] where
@@ -447,8 +443,7 @@ instance (ToJSON a) => ToJSON [a] where
447443 {-# INLINE toJSON #-}
448444
449445instance (FromJSON a) => FromJSON [a] where
450− parseJSON (Array a) = mapM parseJSON (V.toList a)
451− parseJSON v = typeMismatch "[a]" v
446+ parseJSON = withArray "[a]" $ mapM parseJSON . V.toList
452447 {-# INLINE parseJSON #-}
453448
454449instance (ToJSON a) => ToJSON (Vector a) where
@@ -456,8 +451,7 @@ instance (ToJSON a) => ToJSON (Vector a) where
456451 {-# INLINE toJSON #-}
457452
458453instance (FromJSON a) => FromJSON (Vector a) where
459− parseJSON (Array a) = V.mapM parseJSON a
460− parseJSON v = typeMismatch "Vector a" v
454+ parseJSON = withArray "Vector a" $ V.mapM parseJSON
461455 {-# INLINE parseJSON #-}
462456
463457vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
@@ -465,8 +459,7 @@ vectorToJSON = Array . V.map toJSON . V.convert
465459{-# INLINE vectorToJSON #-}
466460
467461vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
468−vectorParseJSON _ (Array a) = V.convert <$> V.mapM parseJSON a
469−vectorParseJSON s v = typeMismatch s v
462+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON
470463{-# INLINE vectorParseJSON #-}
471464
472465instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
@@ -524,8 +517,8 @@ instance (ToJSON v) => ToJSON (M.Map Text v) where
524517 {-# INLINE toJSON #-}
525518
526519instance (FromJSON v) => FromJSON (M.Map Text v) where
527− parseJSON (Object o) = H.foldrWithKey M.insert M.empty <$> traverse parseJSON o
528− parseJSON v = typeMismatch "Map Text a" v
520+ parseJSON = withObject "Map Text a" $
521+ fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON
529522
530523instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
531524 toJSON = Object . mapHashKeyVal LT.toStrict toJSON
@@ -556,8 +549,7 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where
556549 {-# INLINE toJSON #-}
557550
558551instance (FromJSON v) => FromJSON (H.HashMap Text v) where
559− parseJSON (Object o) = traverse parseJSON o
560− parseJSON v = typeMismatch "HashMap Text a" v
552+ parseJSON = withObject "HashMap Text a" $ traverse parseJSON
561553
562554instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
563555 toJSON = Object . mapKeyVal LT.toStrict toJSON
@@ -610,13 +602,12 @@ instance ToJSON DotNetTime where
610602 {-# INLINE toJSON #-}
611603
612604instance FromJSON DotNetTime where
613− parseJSON (String 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
605+ parseJSON = withText "DotNetTime" $ \t ->
606+ let (s,m) = T.splitAt (T.length t - 5) t
618607 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"
620611 {-# INLINE parseJSON #-}
621612
622613instance ToJSON UTCTime where
@@ -625,11 +616,10 @@ instance ToJSON UTCTime where
625616 {-# INLINE toJSON #-}
626617
627618instance FromJSON UTCTime where
628− parseJSON (String t) =
619+ parseJSON = withText "UTCTime" $ \t ->
629620 case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of
630621 Just d -> pure d
631622 _ -> fail "could not parse ISO-8601 date"
632− parseJSON v = typeMismatch "UTCTime" v
633623 {-# INLINE parseJSON #-}
634624
635625instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
@@ -641,14 +631,13 @@ instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
641631 {-# INLINE toJSON #-}
642632
643633instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
644− parseJSON (Array ab)
645− | n == 2 = (,) <$> parseJSON (V.unsafeIndex ab 0)
646− <*> parseJSON (V.unsafeIndex ab 1)
647− | otherwise = fail $ "cannot unpack array of length " ++
648− show n ++ " into a pair"
649− where
650− n = V.length ab
651− parseJSON v = typeMismatch "(a,b)" v
634+ parseJSON = withArray "(a,b)" $ \ab ->
635+ let n = V.length ab
636+ in if n == 2
637+ then (,) <$> parseJSON (V.unsafeIndex ab 0)
638+ <*> parseJSON (V.unsafeIndex ab 1)
639+ else fail $ "cannot unpack array of length " ++
640+ show n ++ " into a pair"
652641 {-# INLINE parseJSON #-}
653642
654643instance (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
661650 {-# INLINE toJSON #-}
662651
663652instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
664− parseJSON (Array abc)
665− | n == 3 = (,,) <$> parseJSON (V.unsafeIndex abc 0)
666− <*> parseJSON (V.unsafeIndex abc 1)
667− <*> parseJSON (V.unsafeIndex abc 2)
668− | otherwise = fail $ "cannot unpack array of length " ++
669− show n ++ " into a 3-tuple"
670− where
671− n = V.length abc
672− parseJSON v = typeMismatch "(a,b,c)" v
653+ parseJSON = withArray "(a,b,c)" $ \abc ->
654+ let n = V.length abc
655+ in if n == 3
656+ then (,,) <$> parseJSON (V.unsafeIndex abc 0)
657+ <*> parseJSON (V.unsafeIndex abc 1)
658+ <*> parseJSON (V.unsafeIndex abc 2)
659+ else fail $ "cannot unpack array of length " ++
660+ show n ++ " into a 3-tuple"
673661 {-# INLINE parseJSON #-}
674662
675663instance (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
683671 {-# INLINE toJSON #-}
684672
685673instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where
686− parseJSON (Array abcd)
687− | n == 4 = (,,,) <$> parseJSON (V.unsafeIndex abcd 0)
688− <*> parseJSON (V.unsafeIndex abcd 1)
689− <*> parseJSON (V.unsafeIndex abcd 2)
690− <*> parseJSON (V.unsafeIndex abcd 3)
691− | otherwise = fail $ "cannot unpack array of length " ++
692− show n ++ " into a 4-tuple"
693− where
694− n = V.length abcd
695− parseJSON v = typeMismatch "(a,b,c,d)" v
674+ parseJSON = withArray "(a,b,c,d)" $ \abcd ->
675+ let n = V.length abcd
676+ in if n == 4
677+ then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)
678+ <*> parseJSON (V.unsafeIndex abcd 1)
679+ <*> parseJSON (V.unsafeIndex abcd 2)
680+ <*> parseJSON (V.unsafeIndex abcd 3)
681+ else fail $ "cannot unpack array of length " ++
682+ show n ++ " into a 4-tuple"
696683 {-# INLINE parseJSON #-}
697684
698685instance ToJSON a => ToJSON (Dual a) where