@@ -24,6 +24,7 @@ import Data.Aeson.Types.Class
2424import Data.Aeson.Types.Internal
2525import Data.Bits (shiftR)
2626import Data.DList (DList, toList, empty)
27+import Data.Maybe (fromMaybe)
2728import Data.Monoid (mappend)
2829import Data.Text (Text, pack, unpack)
2930import GHC.Generics
@@ -272,17 +273,14 @@ instance (ConsFromJSON a) => GFromJSON (C1 c a) where
272273
273274instance ( GFromProduct a, GFromProduct b
274275 , ProductSize a, ProductSize b) => GFromJSON (a :*: b) where
275− gParseJSON opts (Array arr)
276− | lenArray == lenProduct = gParseProduct opts arr 0 lenProduct
277− | otherwise =
278− fail $ "When expecting a product of " ++ show lenProduct ++
279− " values, encountered an Array of " ++ show lenArray ++
280− " elements instead"
281− where
282− lenArray = V.length arr
283− lenProduct = unTagged2 (productSize :: Tagged2 (a :*: b) Int)
284−
285− gParseJSON _opts v = typeMismatch "product (:*:)" v
276+ gParseJSON opts = withArray "product (:*:)" $ \arr ->
277+ let lenArray = V.length arr
278+ lenProduct = unTagged2 (productSize :: Tagged2 (a :*: b) Int) in
279+ if lenArray == lenProduct
280+ then gParseProduct opts arr 0 lenProduct
281+ else fail $ "When expecting a product of " ++ show lenProduct ++
282+ " values, encountered an Array of " ++ show lenArray ++
283+ " elements instead"
286284 {-# INLINE gParseJSON #-}
287285
288286instance (AllNullary (a :+: b) c, GParseSum' c (a :+: b)) => GFromJSON (a :+: b) where
@@ -307,10 +305,9 @@ instance (GFromPair (a :+: b), GFromObjectWithType (a :+: b)) => GParseSum' Fals
307305--------------------------------------------------------------------------------
308306
309307parseSumFromString :: GSumFromString f => Options -> Value -> Parser (f a)
310−parseSumFromString opts (String key) = case gParseSumFromString opts key of
311− Nothing -> notFound $ unpack key
312− Just x -> return x
313−parseSumFromString _ v = typeMismatch "String" v
308+parseSumFromString opts = withText "Text" $ \key ->
309+ maybe (notFound $ unpack key) return $
310+ gParseSumFromString opts key
314311{-# INLINE parseSumFromString #-}
315312
316313class GSumFromString f where
@@ -341,11 +338,10 @@ parseSum opts v =
341338{-# INLINE parseSum #-}
342339
343340parseFromObjectWithSingleField :: (GFromPair (a :+: b)) => Options -> Value -> Parser ((a :+: b) c)
344−parseFromObjectWithSingleField opts (Object (H.toList -> [keyVal@(key, _)])) =
345− case gParsePair opts keyVal of
346− Nothing -> notFound $ unpack key
347− Just p -> p
348−parseFromObjectWithSingleField _opts v = typeMismatch "Object with single field" v
341+parseFromObjectWithSingleField opts = withObject "Object" $ \obj ->
342+ case H.toList obj of
343+ [keyVal@(key, _)] -> fromMaybe (notFound $ unpack key) $ gParsePair opts keyVal
344+ _ -> fail "Object doesn't have a single field"
349345{-# INLINE parseFromObjectWithSingleField #-}
350346
351347notFound :: String -> Parser a
@@ -355,25 +351,23 @@ notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
355351--------------------------------------------------------------------------------
356352
357353parseTwoElemArray :: GFromPair f => Options -> Value -> Parser (f a)
358−parseTwoElemArray opts (Array arr)
359− | V.length arr == 2
360− , String key <- V.unsafeIndex arr 0 =
361− case gParsePair opts (key, V.unsafeIndex arr 1) of
362− Nothing -> notFound $ unpack key
363− Just p -> p
364−parseTwoElemArray _ v = typeMismatch "Array with a key and value element" v
354+parseTwoElemArray opts = withArray "Array" $ \arr ->
355+ if V.length arr == 2
356+ then case V.unsafeIndex arr 0 of
357+ String key -> fromMaybe (notFound $ unpack key) $
358+ gParsePair opts (key, V.unsafeIndex arr 1)
359+ _ -> fail "First element is not a String"
360+ else fail "Array doesn't have 2 elements"
365361{-# INLINE parseTwoElemArray #-}
366362
367363--------------------------------------------------------------------------------
368364
369365parseFromObjectWithType :: (GFromObjectWithType f)
370366 => Options -> String -> String -> Value -> Parser (f a)
371−parseFromObjectWithType opts typeFieldName valueFieldName (Object obj) = do
367+parseFromObjectWithType opts typeFieldName valueFieldName = withObject "Object" $ \obj -> do
372368 key <- obj .: pack typeFieldName
373− case gParseFromObjectWithType opts valueFieldName obj key of
374− Nothing -> notFound $ unpack key
375− Just p -> p
376−parseFromObjectWithType _ _ _ v = typeMismatch "Object" v
369+ fromMaybe (notFound $ unpack key) $
370+ gParseFromObjectWithType opts valueFieldName obj key
377371{-# INLINE parseFromObjectWithType #-}
378372
379373class GFromObjectWithType f where
@@ -428,10 +422,7 @@ instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
428422 {-# INLINE consParseJSON #-}
429423
430424instance (GFromRecord f) => ConsFromJSON' True f where
431− consParseJSON' = Tagged parseRecord
432− where
433− parseRecord opts (Object obj) = gParseRecord opts obj
434− parseRecord _opts v = typeMismatch "record (:*:)" v
425+ consParseJSON' = Tagged $ withObject "record (:*:)" . gParseRecord
435426 {-# INLINE consParseJSON' #-}
436427
437428instance (GFromJSON f) => ConsFromJSON' False f where