f2f73cc · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #398 from Lysxia/bug-357

f2f73ccAdam Bergmark10 years ago

Data/Aeson/TH.hs+2−2

compare with master

unifiedsplit

@@ -107,7 +107,7 @@ import Data.Aeson.Types ( Value(..), Parser

107 , defaultOptions

108 , defaultTaggedObject

109 )

110−import Data.Aeson.Types.Internal (Encoding(..))

110+import Data.Aeson.Types.Internal (Encoding(..), (<?>), JSONPathElement(Key))

111import Control.Monad ( liftM2, return, mapM, fail )

112import Data.Bool ( Bool(False, True), otherwise, (&&), not )

113import Data.Either ( Either(Left, Right) )

@@ -1010,7 +1010,7 @@ instance OVERLAPPABLE_ (FromJSON a) => LookupField a where

1010 lookupField tName rec obj key =

1011 case H.lookup key obj of

1012 Nothing -> unknownFieldFail tName rec (T.unpack key)

1013− Just v -> parseJSON v

1013+ Just v -> parseJSON v <?> Key key

1014

1015instance (FromJSON a) => LookupField (Maybe a) where

1016 lookupField _ _ = (.:?)

Data/Aeson/Types/Generic.hs+10−11

@@ -555,7 +555,7 @@ instance ( FromPair (a :+: b)

555

556parseAllNullarySum :: SumFromString f => Options -> Value -> Parser (f a)

557parseAllNullarySum opts = withText "Text" $ \key ->

558− maybe (notFound $ unpack key) return $

558+ maybe (notFound key) return $

559 parseSumFromString opts key

560

561class SumFromString f where

@@ -582,13 +582,13 @@ parseNonAllNullarySum opts =

582 TaggedObject{..} ->

583 withObject "Object" $ \obj -> do

584 tag <- obj .: pack tagFieldName

585− fromMaybe (notFound $ unpack tag) $

585+ fromMaybe (notFound tag) $

586 parseFromTaggedObject opts contentsFieldName obj tag

587

588 ObjectWithSingleField ->

589 withObject "Object" $ \obj ->

590 case H.toList obj of

591− [pair@(tag, _)] -> fromMaybe (notFound $ unpack tag) $

591+ [pair@(tag, _)] -> fromMaybe (notFound tag) $

592 parsePair opts pair

593 _ -> fail "Object doesn't have a single field"

594

@@ -596,7 +596,7 @@ parseNonAllNullarySum opts =

596 withArray "Array" $ \arr ->

597 if V.length arr == 2

598 then case V.unsafeIndex arr 0 of

599− String tag -> fromMaybe (notFound $ unpack tag) $

599+ String tag -> fromMaybe (notFound tag) $

600 parsePair opts (tag, V.unsafeIndex arr 1)

601 _ -> fail "First element is not a String"

602 else fail "Array doesn't have 2 elements"

@@ -690,12 +690,11 @@ instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where

690 <*> parseRecord opts Nothing obj

691

692instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where

693− parseRecord opts (Just lab) = maybe (notFound $ unpack lab)

693+ parseRecord opts lab = (<?> Key label) . gParseJSON opts <=< (.: label)

694− (gParseJSON opts) . H.lookup lab

695− parseRecord opts Nothing = maybe (notFound label)

696− (gParseJSON opts) . H.lookup (pack label)

697 where

694 where

695+ label = fromMaybe defLabel lab

696+ defLabel = pack . fieldLabelModifier opts $

698− label = fieldLabelModifier opts $ selName (undefined :: t s a p)

697+ selName (undefined :: t s a p)

699

698

700instance OVERLAPPING_ (Selector s, FromJSON a) =>

699instance OVERLAPPING_ (Selector s, FromJSON a) =>

701 FromRecord (S1 s (K1 i (Maybe a))) where

700 FromRecord (S1 s (K1 i (Maybe a))) where

@@ -803,6 +802,6 @@ newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}

803

802

804--------------------------------------------------------------------------------

803--------------------------------------------------------------------------------

805

804

806−notFound :: String -> Parser a

805+notFound :: Text -> Parser a

807−notFound key = fail $ "The key \"" ++ key ++ "\" was not found"

806+notFound key = fail $ "The key \"" ++ unpack key ++ "\" was not found"

808{-# INLINE notFound #-}

807{-# INLINE notFound #-}

Data/Aeson/Types/Instances.hs+3−12

@@ -1396,10 +1396,7 @@ ifromJSON = iparse parseJSON

1396(.:) :: (FromJSON a) => Object -> Text -> Parser a

1397obj .: key = case H.lookup key obj of

1398 Nothing -> fail $ "key " ++ show key ++ " not present"

1399− Just v -> modifyFailure addKeyName

1400− $ parseJSON v <?> Key key

1399+ Just v -> parseJSON v <?> Key key

1401− where

1402− addKeyName = (("failed to parse field " <> unpack key <> ": ") <>)

1403{-# INLINE (.:) #-}

1400{-# INLINE (.:) #-}

1404

1401

1405-- | Retrieve the value associated with the given key of an 'Object'.

1402-- | Retrieve the value associated with the given key of an 'Object'.

@@ -1412,10 +1409,7 @@ obj .: key = case H.lookup key obj of

1412(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

1409(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

1413obj .:? key = case H.lookup key obj of

1410obj .:? key = case H.lookup key obj of

1414 Nothing -> pure Nothing

1411 Nothing -> pure Nothing

1415− Just v -> modifyFailure addKeyName

1416− $ parseJSON v <?> Key key

1412+ Just v -> parseJSON v <?> Key key

1417− where

1418− addKeyName = (("failed to parse field " <> unpack key <> ": ") <>)

1419{-# INLINE (.:?) #-}

1413{-# INLINE (.:?) #-}

1420

1414

1421-- | Like '.:?', but the resulting parser will fail,

1415-- | Like '.:?', but the resulting parser will fail,

@@ -1423,10 +1417,7 @@ obj .:? key = case H.lookup key obj of

1423(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

1417(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

1424obj .:! key = case H.lookup key obj of

1418obj .:! key = case H.lookup key obj of

1425 Nothing -> pure Nothing

1419 Nothing -> pure Nothing

1426− Just v -> modifyFailure addKeyName

1427− $ Just <$> parseJSON v <?> Key key

1420+ Just v -> Just <$> parseJSON v <?> Key key

1428− where

1429− addKeyName = (("failed to parse field " <> unpack key <> ": ") <>)

1430{-# INLINE (.:!) #-}

1421{-# INLINE (.:!) #-}

1431

1422

1432-- | Helper for use in combination with '.:?' to provide default

1423-- | Helper for use in combination with '.:?' to provide default

tests/UnitTests.hs+7−1

@@ -89,7 +89,9 @@ camelFrom c s = let (p:ps) = split c s

89data Wibble = Wibble {

90 wibbleString :: String

91 , wibbleInt :: Int

92− } deriving (Generic, Show)

92+ } deriving (Generic, Show, Eq)

93+

94+instance FromJSON Wibble

94instance ToJSON Wibble where

96instance ToJSON Wibble where

95 toJSON = genericToJSON defaultOptions

97 toJSON = genericToJSON defaultOptions

@@ -270,6 +272,10 @@ jsonPath = [

270 , assertEqual "Seq a"

272 , assertEqual "Seq a"

271 (Left "Error in $[2]: expected Int, encountered Boolean")

273 (Left "Error in $[2]: expected Int, encountered Boolean")

272 (eitherDecode "[0,1,true]" :: Either String (Seq Int))

274 (eitherDecode "[0,1,true]" :: Either String (Seq Int))

275+ , assertEqual "Wibble"

276+ (Left "Error in $.wibbleInt: expected Int, encountered Boolean")

277+ (eitherDecode "{\"wibbleString\":\"\",\"wibbleInt\":true}"

278+ :: Either String Wibble)

273 ]

279 ]

274

280

275------------------------------------------------------------------------------

281------------------------------------------------------------------------------