f2f73cc · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #398 from Lysxia/bug-357

Track JSONPath in autoderived parsers. Fixes #357

commitf2f73ccf8869718dab2becf77aaba9d26f4a81a3 authorAdam Bergmark <adam@bergmark.nl> dateSat 4 Jun 2016, 18:16 (10 years ago) parentf01be6f 4bf4691

4 files changed+22−26

compare with master

unifiedsplit

Data/Aeson/TH.hs+2−2 Data/Aeson/Types/Generic.hs+10−11 Data/Aeson/Types/Instances.hs+3−12 tests/UnitTests.hs+7−1

Data/Aeson/TH.hs+2−2

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

107107 , defaultOptions

108108 , defaultTaggedObject

109109 )

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

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

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

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

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

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

10101010 lookupField tName rec obj key =

10111011 case H.lookup key obj of

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

1013− Just v -> parseJSON v

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

10141014

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

10161016 lookupField _ _ = (.:?)

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

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

555555

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

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

558− maybe (notFound $ unpack key) return $

558+ maybe (notFound key) return $

559559 parseSumFromString opts key

560560

561561class SumFromString f where

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

582582 TaggedObject{..} ->

583583 withObject "Object" $ \obj -> do

584584 tag <- obj .: pack tagFieldName

585− fromMaybe (notFound $ unpack tag) $

585+ fromMaybe (notFound tag) $

586586 parseFromTaggedObject opts contentsFieldName obj tag

587587

588588 ObjectWithSingleField ->

589589 withObject "Object" $ \obj ->

590590 case H.toList obj of

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

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

592592 parsePair opts pair

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

594594

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

596596 withArray "Array" $ \arr ->

597597 if V.length arr == 2

598598 then case V.unsafeIndex arr 0 of

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

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

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

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

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

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

690690 <*> parseRecord opts Nothing obj

691691

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

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

694− (gParseJSON opts) . H.lookup lab

695− parseRecord opts Nothing = maybe (notFound label)

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

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

697694 where

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

695+ label = fromMaybe defLabel lab

696+ defLabel = pack . fieldLabelModifier opts $

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

699698

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

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

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

803802

804803--------------------------------------------------------------------------------

805804

806−notFound :: String -> Parser a

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

805+notFound :: Text -> Parser a

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

808807{-# INLINE notFound #-}

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

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

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

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

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

1399− Just v -> modifyFailure addKeyName

1400− $ parseJSON v <?> Key key

1401− where

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

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

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

14041401

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

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

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

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

14141411 Nothing -> pure Nothing

1415− Just v -> modifyFailure addKeyName

1416− $ parseJSON v <?> Key key

1417− where

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

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

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

14201414

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

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

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

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

14251419 Nothing -> pure Nothing

1426− Just v -> modifyFailure addKeyName

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

1428− where

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

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

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

14311422

14321423-- | 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

8989data Wibble = Wibble {

9090 wibbleString :: String

9191 , wibbleInt :: Int

92− } deriving (Generic, Show)

92+ } deriving (Generic, Show, Eq)

93+

94+instance FromJSON Wibble

9395

9496instance ToJSON Wibble where

9597 toJSON = genericToJSON defaultOptions

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

270272 , assertEqual "Seq a"

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

272274 (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)

273279 ]

274280

275281------------------------------------------------------------------------------