git.iko.soy/typeable/aeson
on master help sign in
Merge
commite7657dad26f93ecb42689eebc78143c18adf6478 authorBryan O'Sullivan <bos@serpentine.com> dateTue 26 May 2015, 12:57 (11 years ago) parentde6a3a3b6a64fc
7 files changed+230−173
compare with master
unifiedsplit
Data/Aeson.hs+8−4 Data/Aeson/Parser/Internal.hs+12−12 Data/Aeson/Types.hs+2 Data/Aeson/Types/Instances.hs+133−127 Data/Aeson/Types/Internal.hs+65−20 tests/Properties.hs+8−8 tests/Properties/ZonedTime.hs+2−2
Data/Aeson.hs+8−4
@@ -142,24 +142,28 @@ decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a
142142decodeStrict' = decodeStrictWith jsonEOF' fromJSON
143143{-# INLINE decodeStrict' #-}
144144
145+eitherFormatError :: Either (JSONPath, String) a -> Either String a
146+eitherFormatError = either (Left . uncurry formatError) Right
147+{-# INLINE eitherFormatError #-}
148+
145149-- | Like 'decode' but returns an error message when decoding fails.
146150eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
147−eitherDecode = eitherDecodeWith jsonEOF fromJSON
151+eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF fromJSON
148152{-# INLINE eitherDecode #-}
149153
150154-- | Like 'decodeStrict' but returns an error message when decoding fails.
151155eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
152−eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
156+eitherDecodeStrict = eitherFormatError . eitherDecodeStrictWith jsonEOF fromJSON
153157{-# INLINE eitherDecodeStrict #-}
154158
155159-- | Like 'decode'' but returns an error message when decoding fails.
156160eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
157−eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
161+eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' fromJSON
158162{-# INLINE eitherDecode' #-}
159163
160164-- | Like 'decodeStrict'' but returns an error message when decoding fails.
161165eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
162−eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
166+eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' fromJSON
163167{-# INLINE eitherDecodeStrict' #-}
164168
165169-- $use
Data/Aeson/Parser/Internal.hs+12−12
@@ -30,7 +30,7 @@ module Data.Aeson.Parser.Internal
3030
3131import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)
3232import Control.Monad.IO.Class (liftIO)
33−import Data.Aeson.Types (Result(..), Value(..))
33+import Data.Aeson.Types (JSONPath, Result(..), Value(..))
3434import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,
3535 skipSpace, string)
3636import Data.Bits ((.|.), shiftL)
@@ -287,27 +287,27 @@ decodeWith p to s =
287287decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
288288 -> Maybe a
289289decodeStrictWith p to s =
290− case either Error to (A.parseOnly p s) of
290+ case either (Error []) to (A.parseOnly p s) of
291291 Success a -> Just a
292− Error _ -> Nothing
292+ _ -> Nothing
293293{-# INLINE decodeStrictWith #-}
294294
295295eitherDecodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString
296− -> Either String a
296+ -> Either (JSONPath, String) a
297297eitherDecodeWith p to s =
298298 case L.parse p s of
299− L.Done _ v -> case to v of
300− Success a -> Right a
301− Error msg -> Left msg
302− L.Fail _ _ msg -> Left msg
299+ L.Done _ v -> case to v of
300+ Success a -> Right a
301+ Error path msg -> Left (path, msg)
302+ L.Fail _ _ msg -> Left ([], msg)
303303{-# INLINE eitherDecodeWith #-}
304304
305305eitherDecodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
306− -> Either String a
306+ -> Either (JSONPath, String) a
307307eitherDecodeStrictWith p to s =
308− case either Error to (A.parseOnly p s) of
309− Success a -> Right a
310− Error msg -> Left msg
308+ case either (Error []) to (A.parseOnly p s) of
309+ Success a -> Right a
310+ Error path msg -> Left (path, msg)
311311{-# INLINE eitherDecodeStrictWith #-}
312312
313313-- $lazy
Data/Aeson/Types.hs+2
@@ -32,6 +32,8 @@ module Data.Aeson.Types
3232 , parseMaybe
3333 , ToJSON(..)
3434 , modifyFailure
35+ , JSONPath
36+ , formatError
3537
3638 -- ** Generic JSON classes
3739 , GFromJSON(..)
Data/Aeson/Types/Instances.hs+133−127
@@ -73,7 +73,7 @@ import Data.Ratio (Ratio, (%), numerator, denominator)
7373import Data.Text (Text, pack, unpack)
7474import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
7575import Data.Time.Format (FormatTime, formatTime, parseTime)
76−import Data.Traversable (traverse)
76+import Data.Traversable as Tr (sequence, traverse)
7777import Data.Vector (Vector)
7878import Data.Word (Word, Word8, Word16, Word32, Word64)
7979import Foreign.Storable (Storable)
@@ -102,6 +102,9 @@ import Data.Time.Format (defaultTimeLocale, dateTimeFmt)
102102import System.Locale (defaultTimeLocale, dateTimeFmt)
103103#endif
104104
105+parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
106+parseIndexedJSON idx value = parseJSON value <?> Index idx
107+
105108instance (ToJSON a) => ToJSON (Identity a) where
106109 toJSON (Identity a) = toJSON a
107110 {-# INLINE toJSON #-}
@@ -421,7 +424,7 @@ instance (ToJSON a) => ToJSON [a] where
421424 where commas = P.foldr (\v vs -> B.char7 ',' <> toEncoding v <> vs) mempty
422425
423426instance (FromJSON a) => FromJSON [a] where
424− parseJSON = withArray "[a]" $ mapM parseJSON . V.toList
427+ parseJSON = withArray "[a]" $ Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList
425428 {-# INLINE parseJSON #-}
426429
427430instance (Foldable t, ToJSON a) => ToJSON (t a) where
@@ -449,7 +452,7 @@ encodeVector xs
449452 where go v b = B.char7 ',' <> toEncoding v <> b
450453
451454instance (FromJSON a) => FromJSON (Vector a) where
452− parseJSON = withArray "Vector a" $ V.mapM parseJSON
455+ parseJSON = withArray "Vector a" $ V.mapM (uncurry parseIndexedJSON) . V.indexed
453456 {-# INLINE parseJSON #-}
454457
455458vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
@@ -457,7 +460,7 @@ vectorToJSON = Array . V.map toJSON . V.convert
457460{-# INLINE vectorToJSON #-}
458461
459462vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
460−vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON
463+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry parseIndexedJSON) . V.indexed
461464{-# INLINE vectorParseJSON #-}
462465
463466instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
@@ -564,7 +567,7 @@ encodePair k v = toEncoding k <> B.char7 ':' <> toEncoding v
564567
565568instance (FromJSON v) => FromJSON (M.Map Text v) where
566569 parseJSON = withObject "Map Text a" $
567− fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON
570+ fmap (H.foldrWithKey M.insert M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
568571
569572instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
570573 toJSON = Object . mapHashKeyVal LT.toStrict toJSON
@@ -589,7 +592,7 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where
589592 toEncoding = encodeWithKey H.foldrWithKey
590593
591594instance (FromJSON v) => FromJSON (H.HashMap Text v) where
592− parseJSON = withObject "HashMap Text a" $ traverse parseJSON
595+ parseJSON = withObject "HashMap Text a" $ H.traverseWithKey (\k v -> parseJSON v <?> Key k)
593596
594597instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
595598 toJSON = Object . mapKeyVal LT.toStrict toJSON
@@ -712,6 +715,9 @@ instance FromJSON UTCTime where
712715 _ -> fail "could not parse ISO-8601 date"
713716 {-# INLINE parseJSON #-}
714717
718+parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a
719+parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) <?> Index idx
720+
715721instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
716722 toJSON (a,b) = Array $ V.create $ do
717723 mv <- VM.unsafeNew 2
@@ -728,8 +734,8 @@ instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
728734 parseJSON = withArray "(a,b)" $ \ab ->
729735 let n = V.length ab
730736 in if n == 2
731− then (,) <$> parseJSON (V.unsafeIndex ab 0)
732− <*> parseJSON (V.unsafeIndex ab 1)
737+ then (,) <$> parseJSONElemAtIndex 0 ab
738+ <*> parseJSONElemAtIndex 1 ab
733739 else fail $ "cannot unpack array of length " ++
734740 show n ++ " into a pair"
735741 {-# INLINE parseJSON #-}
@@ -752,9 +758,9 @@ instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
752758 parseJSON = withArray "(a,b,c)" $ \abc ->
753759 let n = V.length abc
754760 in if n == 3
755− then (,,) <$> parseJSON (V.unsafeIndex abc 0)
756− <*> parseJSON (V.unsafeIndex abc 1)
757− <*> parseJSON (V.unsafeIndex abc 2)
761+ then (,,) <$> parseJSONElemAtIndex 0 abc
762+ <*> parseJSONElemAtIndex 1 abc
763+ <*> parseJSONElemAtIndex 2 abc
758764 else fail $ "cannot unpack array of length " ++
759765 show n ++ " into a 3-tuple"
760766 {-# INLINE parseJSON #-}
@@ -780,10 +786,10 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>
780786 parseJSON = withArray "(a,b,c,d)" $ \abcd ->
781787 let n = V.length abcd
782788 in if n == 4
783− then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)
784− <*> parseJSON (V.unsafeIndex abcd 1)
785− <*> parseJSON (V.unsafeIndex abcd 2)
786− <*> parseJSON (V.unsafeIndex abcd 3)
789+ then (,,,) <$> parseJSONElemAtIndex 0 abcd
790+ <*> parseJSONElemAtIndex 1 abcd
791+ <*> parseJSONElemAtIndex 2 abcd
792+ <*> parseJSONElemAtIndex 3 abcd
787793 else fail $ "cannot unpack array of length " ++
788794 show n ++ " into a 4-tuple"
789795 {-# INLINE parseJSON #-}
@@ -812,11 +818,11 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>
812818 parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->
813819 let n = V.length abcde
814820 in if n == 5
815− then (,,,,) <$> parseJSON (V.unsafeIndex abcde 0)
816− <*> parseJSON (V.unsafeIndex abcde 1)
817− <*> parseJSON (V.unsafeIndex abcde 2)
818− <*> parseJSON (V.unsafeIndex abcde 3)
819− <*> parseJSON (V.unsafeIndex abcde 4)
821+ then (,,,,) <$> parseJSONElemAtIndex 0 abcde
822+ <*> parseJSONElemAtIndex 1 abcde
823+ <*> parseJSONElemAtIndex 2 abcde
824+ <*> parseJSONElemAtIndex 3 abcde
825+ <*> parseJSONElemAtIndex 4 abcde
820826 else fail $ "cannot unpack array of length " ++
821827 show n ++ " into a 5-tuple"
822828 {-# INLINE parseJSON #-}
@@ -847,12 +853,12 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
847853 parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->
848854 let n = V.length abcdef
849855 in if n == 6
850− then (,,,,,) <$> parseJSON (V.unsafeIndex abcdef 0)
851− <*> parseJSON (V.unsafeIndex abcdef 1)
852− <*> parseJSON (V.unsafeIndex abcdef 2)
853− <*> parseJSON (V.unsafeIndex abcdef 3)
854− <*> parseJSON (V.unsafeIndex abcdef 4)
855− <*> parseJSON (V.unsafeIndex abcdef 5)
856+ then (,,,,,) <$> parseJSONElemAtIndex 0 abcdef
857+ <*> parseJSONElemAtIndex 1 abcdef
858+ <*> parseJSONElemAtIndex 2 abcdef
859+ <*> parseJSONElemAtIndex 3 abcdef
860+ <*> parseJSONElemAtIndex 4 abcdef
861+ <*> parseJSONElemAtIndex 5 abcdef
856862 else fail $ "cannot unpack array of length " ++
857863 show n ++ " into a 6-tuple"
858864 {-# INLINE parseJSON #-}
@@ -885,13 +891,13 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
885891 parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->
886892 let n = V.length abcdefg
887893 in if n == 7
888− then (,,,,,,) <$> parseJSON (V.unsafeIndex abcdefg 0)
889− <*> parseJSON (V.unsafeIndex abcdefg 1)
890− <*> parseJSON (V.unsafeIndex abcdefg 2)
891− <*> parseJSON (V.unsafeIndex abcdefg 3)
892− <*> parseJSON (V.unsafeIndex abcdefg 4)
893− <*> parseJSON (V.unsafeIndex abcdefg 5)
894− <*> parseJSON (V.unsafeIndex abcdefg 6)
894+ then (,,,,,,) <$> parseJSONElemAtIndex 0 abcdefg
895+ <*> parseJSONElemAtIndex 1 abcdefg
896+ <*> parseJSONElemAtIndex 2 abcdefg
897+ <*> parseJSONElemAtIndex 3 abcdefg
898+ <*> parseJSONElemAtIndex 4 abcdefg
899+ <*> parseJSONElemAtIndex 5 abcdefg
900+ <*> parseJSONElemAtIndex 6 abcdefg
895901 else fail $ "cannot unpack array of length " ++
896902 show n ++ " into a 7-tuple"
897903 {-# INLINE parseJSON #-}
@@ -930,14 +936,14 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
930936 then fail $ "cannot unpack array of length " ++
931937 show n ++ " into an 8-tuple"
932938 else (,,,,,,,)
933− <$> parseJSON (V.unsafeIndex ary 0)
934− <*> parseJSON (V.unsafeIndex ary 1)
935− <*> parseJSON (V.unsafeIndex ary 2)
936− <*> parseJSON (V.unsafeIndex ary 3)
937− <*> parseJSON (V.unsafeIndex ary 4)
938− <*> parseJSON (V.unsafeIndex ary 5)
939− <*> parseJSON (V.unsafeIndex ary 6)
940− <*> parseJSON (V.unsafeIndex ary 7)
939+ <$> parseJSONElemAtIndex 0 ary
940+ <*> parseJSONElemAtIndex 1 ary
941+ <*> parseJSONElemAtIndex 2 ary
942+ <*> parseJSONElemAtIndex 3 ary
943+ <*> parseJSONElemAtIndex 4 ary
944+ <*> parseJSONElemAtIndex 5 ary
945+ <*> parseJSONElemAtIndex 6 ary
946+ <*> parseJSONElemAtIndex 7 ary
941947 {-# INLINE parseJSON #-}
942948
943949instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -976,15 +982,15 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
976982 then fail $ "cannot unpack array of length " ++
977983 show n ++ " into a 9-tuple"
978984 else (,,,,,,,,)
979− <$> parseJSON (V.unsafeIndex ary 0)
980− <*> parseJSON (V.unsafeIndex ary 1)
981− <*> parseJSON (V.unsafeIndex ary 2)
982− <*> parseJSON (V.unsafeIndex ary 3)
983− <*> parseJSON (V.unsafeIndex ary 4)
984− <*> parseJSON (V.unsafeIndex ary 5)
985− <*> parseJSON (V.unsafeIndex ary 6)
986− <*> parseJSON (V.unsafeIndex ary 7)
987− <*> parseJSON (V.unsafeIndex ary 8)
985+ <$> parseJSONElemAtIndex 0 ary
986+ <*> parseJSONElemAtIndex 1 ary
987+ <*> parseJSONElemAtIndex 2 ary
988+ <*> parseJSONElemAtIndex 3 ary
989+ <*> parseJSONElemAtIndex 4 ary
990+ <*> parseJSONElemAtIndex 5 ary
991+ <*> parseJSONElemAtIndex 6 ary
992+ <*> parseJSONElemAtIndex 7 ary
993+ <*> parseJSONElemAtIndex 8 ary
988994 {-# INLINE parseJSON #-}
989995
990996instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1026,16 +1032,16 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
10261032 then fail $ "cannot unpack array of length " ++
10271033 show n ++ " into a 10-tuple"
10281034 else (,,,,,,,,,)
1029− <$> parseJSON (V.unsafeIndex ary 0)
1030− <*> parseJSON (V.unsafeIndex ary 1)
1031− <*> parseJSON (V.unsafeIndex ary 2)
1032− <*> parseJSON (V.unsafeIndex ary 3)
1033− <*> parseJSON (V.unsafeIndex ary 4)
1034− <*> parseJSON (V.unsafeIndex ary 5)
1035− <*> parseJSON (V.unsafeIndex ary 6)
1036− <*> parseJSON (V.unsafeIndex ary 7)
1037− <*> parseJSON (V.unsafeIndex ary 8)
1038− <*> parseJSON (V.unsafeIndex ary 9)
1035+ <$> parseJSONElemAtIndex 0 ary
1036+ <*> parseJSONElemAtIndex 1 ary
1037+ <*> parseJSONElemAtIndex 2 ary
1038+ <*> parseJSONElemAtIndex 3 ary
1039+ <*> parseJSONElemAtIndex 4 ary
1040+ <*> parseJSONElemAtIndex 5 ary
1041+ <*> parseJSONElemAtIndex 6 ary
1042+ <*> parseJSONElemAtIndex 7 ary
1043+ <*> parseJSONElemAtIndex 8 ary
1044+ <*> parseJSONElemAtIndex 9 ary
10391045 {-# INLINE parseJSON #-}
10401046
10411047instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1080,17 +1086,17 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
10801086 then fail $ "cannot unpack array of length " ++
10811087 show n ++ " into an 11-tuple"
10821088 else (,,,,,,,,,,)
1083− <$> parseJSON (V.unsafeIndex ary 0)
1084− <*> parseJSON (V.unsafeIndex ary 1)
1085− <*> parseJSON (V.unsafeIndex ary 2)
1086− <*> parseJSON (V.unsafeIndex ary 3)
1087− <*> parseJSON (V.unsafeIndex ary 4)
1088− <*> parseJSON (V.unsafeIndex ary 5)
1089− <*> parseJSON (V.unsafeIndex ary 6)
1090− <*> parseJSON (V.unsafeIndex ary 7)
1091− <*> parseJSON (V.unsafeIndex ary 8)
1092− <*> parseJSON (V.unsafeIndex ary 9)
1093− <*> parseJSON (V.unsafeIndex ary 10)
1089+ <$> parseJSONElemAtIndex 0 ary
1090+ <*> parseJSONElemAtIndex 1 ary
1091+ <*> parseJSONElemAtIndex 2 ary
1092+ <*> parseJSONElemAtIndex 3 ary
1093+ <*> parseJSONElemAtIndex 4 ary
1094+ <*> parseJSONElemAtIndex 5 ary
1095+ <*> parseJSONElemAtIndex 6 ary
1096+ <*> parseJSONElemAtIndex 7 ary
1097+ <*> parseJSONElemAtIndex 8 ary
1098+ <*> parseJSONElemAtIndex 9 ary
1099+ <*> parseJSONElemAtIndex 10 ary
10941100 {-# INLINE parseJSON #-}
10951101
10961102instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1137,18 +1143,18 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
11371143 then fail $ "cannot unpack array of length " ++
11381144 show n ++ " into a 12-tuple"
11391145 else (,,,,,,,,,,,)
1140− <$> parseJSON (V.unsafeIndex ary 0)
1141− <*> parseJSON (V.unsafeIndex ary 1)
1142− <*> parseJSON (V.unsafeIndex ary 2)
1143− <*> parseJSON (V.unsafeIndex ary 3)
1144− <*> parseJSON (V.unsafeIndex ary 4)
1145− <*> parseJSON (V.unsafeIndex ary 5)
1146− <*> parseJSON (V.unsafeIndex ary 6)
1147− <*> parseJSON (V.unsafeIndex ary 7)
1148− <*> parseJSON (V.unsafeIndex ary 8)
1149− <*> parseJSON (V.unsafeIndex ary 9)
1150− <*> parseJSON (V.unsafeIndex ary 10)
1151− <*> parseJSON (V.unsafeIndex ary 11)
1146+ <$> parseJSONElemAtIndex 0 ary
1147+ <*> parseJSONElemAtIndex 1 ary
1148+ <*> parseJSONElemAtIndex 2 ary
1149+ <*> parseJSONElemAtIndex 3 ary
1150+ <*> parseJSONElemAtIndex 4 ary
1151+ <*> parseJSONElemAtIndex 5 ary
1152+ <*> parseJSONElemAtIndex 6 ary
1153+ <*> parseJSONElemAtIndex 7 ary
1154+ <*> parseJSONElemAtIndex 8 ary
1155+ <*> parseJSONElemAtIndex 9 ary
1156+ <*> parseJSONElemAtIndex 10 ary
1157+ <*> parseJSONElemAtIndex 11 ary
11521158 {-# INLINE parseJSON #-}
11531159
11541160instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1198,19 +1204,19 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
11981204 then fail $ "cannot unpack array of length " ++
11991205 show n ++ " into a 13-tuple"
12001206 else (,,,,,,,,,,,,)
1201− <$> parseJSON (V.unsafeIndex ary 0)
1202− <*> parseJSON (V.unsafeIndex ary 1)
1203− <*> parseJSON (V.unsafeIndex ary 2)
1204− <*> parseJSON (V.unsafeIndex ary 3)
1205− <*> parseJSON (V.unsafeIndex ary 4)
1206− <*> parseJSON (V.unsafeIndex ary 5)
1207− <*> parseJSON (V.unsafeIndex ary 6)
1208− <*> parseJSON (V.unsafeIndex ary 7)
1209− <*> parseJSON (V.unsafeIndex ary 8)
1210− <*> parseJSON (V.unsafeIndex ary 9)
1211− <*> parseJSON (V.unsafeIndex ary 10)
1212− <*> parseJSON (V.unsafeIndex ary 11)
1213− <*> parseJSON (V.unsafeIndex ary 12)
1207+ <$> parseJSONElemAtIndex 0 ary
1208+ <*> parseJSONElemAtIndex 1 ary
1209+ <*> parseJSONElemAtIndex 2 ary
1210+ <*> parseJSONElemAtIndex 3 ary
1211+ <*> parseJSONElemAtIndex 4 ary
1212+ <*> parseJSONElemAtIndex 5 ary
1213+ <*> parseJSONElemAtIndex 6 ary
1214+ <*> parseJSONElemAtIndex 7 ary
1215+ <*> parseJSONElemAtIndex 8 ary
1216+ <*> parseJSONElemAtIndex 9 ary
1217+ <*> parseJSONElemAtIndex 10 ary
1218+ <*> parseJSONElemAtIndex 11 ary
1219+ <*> parseJSONElemAtIndex 12 ary
12141220 {-# INLINE parseJSON #-}
12151221
12161222instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1262,20 +1268,20 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
12621268 then fail $ "cannot unpack array of length " ++
12631269 show n ++ " into a 14-tuple"
12641270 else (,,,,,,,,,,,,,)
1265− <$> parseJSON (V.unsafeIndex ary 0)
1266− <*> parseJSON (V.unsafeIndex ary 1)
1267− <*> parseJSON (V.unsafeIndex ary 2)
1268− <*> parseJSON (V.unsafeIndex ary 3)
1269− <*> parseJSON (V.unsafeIndex ary 4)
1270− <*> parseJSON (V.unsafeIndex ary 5)
1271− <*> parseJSON (V.unsafeIndex ary 6)
1272− <*> parseJSON (V.unsafeIndex ary 7)
1273− <*> parseJSON (V.unsafeIndex ary 8)
1274− <*> parseJSON (V.unsafeIndex ary 9)
1275− <*> parseJSON (V.unsafeIndex ary 10)
1276− <*> parseJSON (V.unsafeIndex ary 11)
1277− <*> parseJSON (V.unsafeIndex ary 12)
1278− <*> parseJSON (V.unsafeIndex ary 13)
1271+ <$> parseJSONElemAtIndex 0 ary
1272+ <*> parseJSONElemAtIndex 1 ary
1273+ <*> parseJSONElemAtIndex 2 ary
1274+ <*> parseJSONElemAtIndex 3 ary
1275+ <*> parseJSONElemAtIndex 4 ary
1276+ <*> parseJSONElemAtIndex 5 ary
1277+ <*> parseJSONElemAtIndex 6 ary
1278+ <*> parseJSONElemAtIndex 7 ary
1279+ <*> parseJSONElemAtIndex 8 ary
1280+ <*> parseJSONElemAtIndex 9 ary
1281+ <*> parseJSONElemAtIndex 10 ary
1282+ <*> parseJSONElemAtIndex 11 ary
1283+ <*> parseJSONElemAtIndex 12 ary
1284+ <*> parseJSONElemAtIndex 13 ary
12791285 {-# INLINE parseJSON #-}
12801286
12811287instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1329,21 +1335,21 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
13291335 then fail $ "cannot unpack array of length " ++
13301336 show n ++ " into a 15-tuple"
13311337 else (,,,,,,,,,,,,,,)
1332− <$> parseJSON (V.unsafeIndex ary 0)
1333− <*> parseJSON (V.unsafeIndex ary 1)
1334− <*> parseJSON (V.unsafeIndex ary 2)
1335− <*> parseJSON (V.unsafeIndex ary 3)
1336− <*> parseJSON (V.unsafeIndex ary 4)
1337− <*> parseJSON (V.unsafeIndex ary 5)
1338− <*> parseJSON (V.unsafeIndex ary 6)
1339− <*> parseJSON (V.unsafeIndex ary 7)
1340− <*> parseJSON (V.unsafeIndex ary 8)
1341− <*> parseJSON (V.unsafeIndex ary 9)
1342− <*> parseJSON (V.unsafeIndex ary 10)
1343− <*> parseJSON (V.unsafeIndex ary 11)
1344− <*> parseJSON (V.unsafeIndex ary 12)
1345− <*> parseJSON (V.unsafeIndex ary 13)
1346− <*> parseJSON (V.unsafeIndex ary 14)
1338+ <$> parseJSONElemAtIndex 0 ary
1339+ <*> parseJSONElemAtIndex 1 ary
1340+ <*> parseJSONElemAtIndex 2 ary
1341+ <*> parseJSONElemAtIndex 3 ary
1342+ <*> parseJSONElemAtIndex 4 ary
1343+ <*> parseJSONElemAtIndex 5 ary
1344+ <*> parseJSONElemAtIndex 6 ary
1345+ <*> parseJSONElemAtIndex 7 ary
1346+ <*> parseJSONElemAtIndex 8 ary
1347+ <*> parseJSONElemAtIndex 9 ary
1348+ <*> parseJSONElemAtIndex 10 ary
1349+ <*> parseJSONElemAtIndex 11 ary
1350+ <*> parseJSONElemAtIndex 12 ary
1351+ <*> parseJSONElemAtIndex 13 ary
1352+ <*> parseJSONElemAtIndex 14 ary
13471353 {-# INLINE parseJSON #-}
13481354
13491355instance ToJSON a => ToJSON (Dual a) where
@@ -1445,7 +1451,7 @@ fromJSON = parse parseJSON
14451451(.:) :: (FromJSON a) => Object -> Text -> Parser a
14461452obj .: key = case H.lookup key obj of
14471453 Nothing -> fail $ "key " ++ show key ++ " not present"
1448− Just v -> parseJSON v
1454+ Just v -> parseJSON v <?> Key key
14491455{-# INLINE (.:) #-}
14501456
14511457-- | Retrieve the value associated with the given key of an 'Object'.
@@ -1458,7 +1464,7 @@ obj .: key = case H.lookup key obj of
14581464(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
14591465obj .:? key = case H.lookup key obj of
14601466 Nothing -> pure Nothing
1461− Just v -> parseJSON v
1467+ Just v -> parseJSON v <?> Key key
14621468{-# INLINE (.:?) #-}
14631469
14641470-- | Helper for use in combination with '.:?' to provide default
Data/Aeson/Types/Internal.hs+65−20
@@ -25,10 +25,14 @@ module Data.Aeson.Types.Internal
2525 -- * Type conversion
2626 , Parser
2727 , Result(..)
28+ , JSONPathElement(..)
29+ , JSONPath
2830 , parse
2931 , parseEither
3032 , parseMaybe
3133 , modifyFailure
34+ , formatError
35+ , (<?>)
3236 -- * Constructors and accessors
3337 , object
3438
@@ -56,7 +60,7 @@ import Data.Data (Data)
5660import Data.HashMap.Strict (HashMap)
5761import Data.Monoid (Monoid(..), (<>))
5862import Data.String (IsString(..))
59−import Data.Text (Text, pack)
63+import Data.Text (Text, pack, unpack)
6064import Data.Time (UTCTime)
6165import Data.Time.Format (FormatTime)
6266import Data.Typeable (Typeable)
@@ -64,25 +68,37 @@ import Data.Vector (Vector)
6468import qualified Data.HashMap.Strict as H
6569import qualified Data.Vector as V
6670
71+-- | Elements of JSON path used to describe error location
72+data JSONPathElement = -- ^ "object.key" JSON path element
73+ Key Text
74+ -- ^ "array[index]" JSON path element
75+ | Index {-# UNPACK #-} !Int
76+ deriving (Eq, Show, Typeable)
77+type JSONPath = [JSONPathElement]
78+
6779-- | The result of running a 'Parser'.
68−data Result a = Error String
80+data Result a = Error JSONPath String
6981 | Success a
7082 deriving (Eq, Show, Typeable)
7183
84+instance NFData JSONPathElement where
85+ rnf (Key t) = rnf t
86+ rnf (Index i) = rnf i
87+
7288instance (NFData a) => NFData (Result a) where
7389 rnf (Success a) = rnf a
74− rnf (Error err) = rnf err
90+ rnf (Error path err) = rnf path `seq` rnf err
7591
7692instance Functor Result where
7793 fmap f (Success a) = Success (f a)
78− fmap _ (Error err) = Error err
94+ fmap _ (Error path err) = Error path err
7995 {-# INLINE fmap #-}
8096
8197instance Monad Result where
8298 return = Success
8399 {-# INLINE return #-}
84− Success a >>= k = k a
85− Error err >>= _ = Error err
100+ Success a >>= k = k a
101+ Error path err >>= _ = Error path err
86102 {-# INLINE (>>=) #-}
87103
88104instance Applicative Result where
@@ -111,30 +127,31 @@ instance Monoid (Result a) where
111127 {-# INLINE mappend #-}
112128
113129-- | Failure continuation.
114−type Failure f r = String -> f r
130+type Failure f r = JSONPath -> String -> f r
115131-- | Success continuation.
116132type Success a f r = a -> f r
117133
118134-- | A continuation-based parser type.
119135newtype Parser a = Parser {
120136 runParser :: forall f r.
121− Failure f r
137+ JSONPath
138+ -> Failure f r
122139 -> Success a f r
123140 -> f r
124141 }
125142
126143instance Monad Parser where
127− m >>= g = Parser $ \kf ks -> let ks' a = runParser (g a) kf ks
128− in runParser m kf ks'
144+ m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks
145+ in runParser m path kf ks'
129146 {-# INLINE (>>=) #-}
130− return a = Parser $ \_kf ks -> ks a
147+ return a = Parser $ \_path _kf ks -> ks a
131148 {-# INLINE return #-}
132− fail msg = Parser $ \kf _ks -> kf msg
149+ fail msg = Parser $ \path kf _ks -> kf (reverse path) msg
133150 {-# INLINE fail #-}
134151
135152instance Functor Parser where
136− fmap f m = Parser $ \kf ks -> let ks' a = ks (f a)
137− in runParser m kf ks'
153+ fmap f m = Parser $ \path kf ks -> let ks' a = ks (f a)
154+ in runParser m path kf ks'
138155 {-# INLINE fmap #-}
139156
140157instance Applicative Parser where
@@ -152,8 +169,8 @@ instance Alternative Parser where
152169instance MonadPlus Parser where
153170 mzero = fail "mzero"
154171 {-# INLINE mzero #-}
155− mplus a b = Parser $ \kf ks -> let kf' _ = runParser b kf ks
156− in runParser a kf' ks
172+ mplus a b = Parser $ \path kf ks -> let kf' _ _ = runParser b path kf ks
173+ in runParser a path kf' ks
157174 {-# INLINE mplus #-}
158175
159176instance Monoid (Parser a) where
@@ -252,19 +269,29 @@ emptyObject = Object H.empty
252269
253270-- | Run a 'Parser'.
254271parse :: (a -> Parser b) -> a -> Result b
255−parse m v = runParser (m v) Error Success
272+parse m v = runParser (m v) [] Error Success
256273{-# INLINE parse #-}
257274
258275-- | Run a 'Parser' with a 'Maybe' result type.
259276parseMaybe :: (a -> Parser b) -> a -> Maybe b
260−parseMaybe m v = runParser (m v) (const Nothing) Just
277+parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just
261278{-# INLINE parseMaybe #-}
262279
263280-- | Run a 'Parser' with an 'Either' result type.
264281parseEither :: (a -> Parser b) -> a -> Either String b
265−parseEither m v = runParser (m v) Left Right
282+parseEither m v = runParser (m v) [] (\path msg -> Left $ formatError path msg) Right
266283{-# INLINE parseEither #-}
267284
285+-- | Annotate error message with JSON Path error location
286+formatError :: JSONPath -> String -> String
287+formatError path msg = "Error in " ++ (formatJSONPath path) ++ ": " ++ msg
288+ where formatJSONPath :: JSONPath -> String
289+ formatJSONPath p = format "$" p
290+ where format :: String -> JSONPath -> String
291+ format prefix [] = prefix
292+ format prefix (Index idx:parts) = format (prefix ++ "[" ++ show idx ++ "]") parts
293+ format prefix (Key key:parts) = format (prefix ++ "." ++ unpack key) parts
294+
268295-- | A key\/value pair for an 'Object'.
269296type Pair = (Text, Value)
270297
@@ -274,6 +301,24 @@ object :: [Pair] -> Value
274301object = Object . H.fromList
275302{-# INLINE object #-}
276303
304+-- | Add JSON Path context to a parser
305+--
306+-- When parsing complex structure it helps to annotate (sub)parsers
307+-- with context so that if error occurs you can find it's location.
308+--
309+-- > withObject "Person" $ \o ->
310+-- > Person
311+-- > <$> o .: "name" <?> Key "name"
312+-- > <*> o .: "age" <?> Key "age"
313+--
314+-- (except for standard methods like '(.:)' already do that)
315+--
316+-- After that in case of error you will get a JSON Path location of that error.
317+--
318+-- Since 0.9
319+(<?>) :: Parser a -> JSONPathElement -> Parser a
320+p <?> pathElem = Parser $ \path kf ks -> runParser p (pathElem:path) kf ks
321+
277322-- | If the inner @Parser@ failed, modify the failure message using the
278323-- provided function. This allows you to create more descriptive error messages.
279324-- For example:
@@ -284,7 +329,7 @@ object = Object . H.fromList
284329--
285330-- Since 0.6.2.0
286331modifyFailure :: (String -> String) -> Parser a -> Parser a
287−modifyFailure f (Parser p) = Parser $ \kf -> p (kf . f)
332+modifyFailure f (Parser p) = Parser $ \path kf ks -> p path (\p' m -> kf p' (f m)) ks
288333
289334--------------------------------------------------------------------------------
290335-- Generic and TH encoding configuration
tests/Properties.hs+8−8
@@ -49,28 +49,28 @@ toParseJSON :: (Arbitrary a, Eq a, Show a) =>
4949 (Value -> Parser a) -> (a -> Value) -> a -> Property
5050toParseJSON parsejson tojson x =
5151 case parse parsejson . tojson $ x of
52− Error msg -> failure "parse" msg x
53− Success x' -> x === x'
52+ Error path msg -> failure "parse" (formatError path msg) x
53+ Success x' -> x === x'
5454
5555roundTrip :: (FromJSON a, ToJSON a, Show a) =>
5656 (a -> a -> Property) -> a -> a -> Property
5757roundTrip eq _ i =
5858 case fmap fromJSON . L.parse value . encode . toJSON $ i of
59− L.Done _ (Success v) -> v `eq` i
60− L.Done _ (Error err) -> failure "fromJSON" err i
61− L.Fail _ _ err -> failure "parse" err i
59+ L.Done _ (Success v) -> v `eq` i
60+ L.Done _ (Error path err) -> failure "fromJSON" (formatError path err) i
61+ L.Fail _ _ err -> failure "parse" err i
6262
6363roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property
6464roundTripEq x y = roundTrip (===) x y
6565
6666toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property
6767toFromJSON x = case fromJSON (toJSON x) of
68− Error err -> failure "fromJSON" err x
69− Success x' -> x === x'
68+ Error path err -> failure "fromJSON" (formatError path err) x
69+ Success x' -> x === x'
7070
7171modifyFailureProp :: String -> String -> Bool
7272modifyFailureProp orig added =
73− result == Error (added ++ orig)
73+ result == Error [] (added ++ orig)
7474 where
7575 parser = const $ modifyFailure (added ++) $ fail orig
7676 result :: Result ()
tests/Properties/ZonedTime.hs+2−2
@@ -43,8 +43,8 @@ zonedTimeToJSON = testGroup "ZonedTime" [
4343 test format f = testProperty format go
4444 where
4545 go t = case fromJSON (toJSON' format t) of
46− Error msg -> failure "fromJSON" msg t
47− Success t' -> t' === f t
46+ Error path msg -> failure "fromJSON" (formatError path msg) t
47+ Success t' -> t' === f t
4848
4949clearTimeZone :: ZonedTime -> ZonedTime
5050clearTimeZone t = t { zonedTimeZone = TimeZone 0 False "" }