git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #220 from maximkulkin/json-path-error-reporting

Add json path to parse error messages

commitb6a64fc720dabebe79dff92821fa4d9396d875b3 authorBryan O'Sullivan <bos@serpentine.com> dateTue 26 May 2015, 12:27 (11 years ago) parent596b808702a0da
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
@@ -141,24 +141,28 @@ decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a
141141decodeStrict' = decodeStrictWith jsonEOF' fromJSON
142142{-# INLINE decodeStrict' #-}
143143
144+eitherFormatError :: Either (JSONPath, String) a -> Either String a
145+eitherFormatError = either (Left . uncurry formatError) Right
146+{-# INLINE eitherFormatError #-}
147+
144148-- | Like 'decode' but returns an error message when decoding fails.
145149eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
146−eitherDecode = eitherDecodeWith jsonEOF fromJSON
150+eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF fromJSON
147151{-# INLINE eitherDecode #-}
148152
149153-- | Like 'decodeStrict' but returns an error message when decoding fails.
150154eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
151−eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
155+eitherDecodeStrict = eitherFormatError . eitherDecodeStrictWith jsonEOF fromJSON
152156{-# INLINE eitherDecodeStrict #-}
153157
154158-- | Like 'decode'' but returns an error message when decoding fails.
155159eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
156−eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
160+eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' fromJSON
157161{-# INLINE eitherDecode' #-}
158162
159163-- | Like 'decodeStrict'' but returns an error message when decoding fails.
160164eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
161−eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
165+eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' fromJSON
162166{-# INLINE eitherDecodeStrict' #-}
163167
164168-- $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
@@ -72,7 +72,7 @@ import Data.Ratio (Ratio, (%), numerator, denominator)
7272import Data.Text (Text, pack, unpack)
7373import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
7474import Data.Time.Format (FormatTime, formatTime, parseTime)
75−import Data.Traversable (traverse)
75+import Data.Traversable as Tr (sequence, traverse)
7676import Data.Vector (Vector)
7777import Data.Word (Word, Word8, Word16, Word32, Word64)
7878import Foreign.Storable (Storable)
@@ -101,6 +101,9 @@ import Data.Time.Format (defaultTimeLocale, dateTimeFmt)
101101import System.Locale (defaultTimeLocale, dateTimeFmt)
102102#endif
103103
104+parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
105+parseIndexedJSON idx value = parseJSON value <?> Index idx
106+
104107instance (ToJSON a) => ToJSON (Identity a) where
105108 toJSON (Identity a) = toJSON a
106109 {-# INLINE toJSON #-}
@@ -420,7 +423,7 @@ instance (ToJSON a) => ToJSON [a] where
420423 where commas = P.foldr (\v vs -> B.char7 ',' <> toEncoding v <> vs) mempty
421424
422425instance (FromJSON a) => FromJSON [a] where
423− parseJSON = withArray "[a]" $ mapM parseJSON . V.toList
426+ parseJSON = withArray "[a]" $ Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList
424427 {-# INLINE parseJSON #-}
425428
426429instance (Foldable t, ToJSON a) => ToJSON (t a) where
@@ -448,7 +451,7 @@ encodeVector xs
448451 where go v b = B.char7 ',' <> toEncoding v <> b
449452
450453instance (FromJSON a) => FromJSON (Vector a) where
451− parseJSON = withArray "Vector a" $ V.mapM parseJSON
454+ parseJSON = withArray "Vector a" $ V.mapM (uncurry parseIndexedJSON) . V.indexed
452455 {-# INLINE parseJSON #-}
453456
454457vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
@@ -456,7 +459,7 @@ vectorToJSON = Array . V.map toJSON . V.convert
456459{-# INLINE vectorToJSON #-}
457460
458461vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)
459−vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON
462+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry parseIndexedJSON) . V.indexed
460463{-# INLINE vectorParseJSON #-}
461464
462465instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
@@ -563,7 +566,7 @@ encodePair k v = toEncoding k <> B.char7 ':' <> toEncoding v
563566
564567instance (FromJSON v) => FromJSON (M.Map Text v) where
565568 parseJSON = withObject "Map Text a" $
566− fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON
569+ fmap (H.foldrWithKey M.insert M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
567570
568571instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
569572 toJSON = Object . mapHashKeyVal LT.toStrict toJSON
@@ -588,7 +591,7 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where
588591 toEncoding = encodeWithKey H.foldrWithKey
589592
590593instance (FromJSON v) => FromJSON (H.HashMap Text v) where
591− parseJSON = withObject "HashMap Text a" $ traverse parseJSON
594+ parseJSON = withObject "HashMap Text a" $ H.traverseWithKey (\k v -> parseJSON v <?> Key k)
592595
593596instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
594597 toJSON = Object . mapKeyVal LT.toStrict toJSON
@@ -711,6 +714,9 @@ instance FromJSON UTCTime where
711714 _ -> fail "could not parse ISO-8601 date"
712715 {-# INLINE parseJSON #-}
713716
717+parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a
718+parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) <?> Index idx
719+
714720instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
715721 toJSON (a,b) = Array $ V.create $ do
716722 mv <- VM.unsafeNew 2
@@ -727,8 +733,8 @@ instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
727733 parseJSON = withArray "(a,b)" $ \ab ->
728734 let n = V.length ab
729735 in if n == 2
730− then (,) <$> parseJSON (V.unsafeIndex ab 0)
731− <*> parseJSON (V.unsafeIndex ab 1)
736+ then (,) <$> parseJSONElemAtIndex 0 ab
737+ <*> parseJSONElemAtIndex 1 ab
732738 else fail $ "cannot unpack array of length " ++
733739 show n ++ " into a pair"
734740 {-# INLINE parseJSON #-}
@@ -751,9 +757,9 @@ instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
751757 parseJSON = withArray "(a,b,c)" $ \abc ->
752758 let n = V.length abc
753759 in if n == 3
754− then (,,) <$> parseJSON (V.unsafeIndex abc 0)
755− <*> parseJSON (V.unsafeIndex abc 1)
756− <*> parseJSON (V.unsafeIndex abc 2)
760+ then (,,) <$> parseJSONElemAtIndex 0 abc
761+ <*> parseJSONElemAtIndex 1 abc
762+ <*> parseJSONElemAtIndex 2 abc
757763 else fail $ "cannot unpack array of length " ++
758764 show n ++ " into a 3-tuple"
759765 {-# INLINE parseJSON #-}
@@ -779,10 +785,10 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>
779785 parseJSON = withArray "(a,b,c,d)" $ \abcd ->
780786 let n = V.length abcd
781787 in if n == 4
782− then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)
783− <*> parseJSON (V.unsafeIndex abcd 1)
784− <*> parseJSON (V.unsafeIndex abcd 2)
785− <*> parseJSON (V.unsafeIndex abcd 3)
788+ then (,,,) <$> parseJSONElemAtIndex 0 abcd
789+ <*> parseJSONElemAtIndex 1 abcd
790+ <*> parseJSONElemAtIndex 2 abcd
791+ <*> parseJSONElemAtIndex 3 abcd
786792 else fail $ "cannot unpack array of length " ++
787793 show n ++ " into a 4-tuple"
788794 {-# INLINE parseJSON #-}
@@ -811,11 +817,11 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>
811817 parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->
812818 let n = V.length abcde
813819 in if n == 5
814− then (,,,,) <$> parseJSON (V.unsafeIndex abcde 0)
815− <*> parseJSON (V.unsafeIndex abcde 1)
816− <*> parseJSON (V.unsafeIndex abcde 2)
817− <*> parseJSON (V.unsafeIndex abcde 3)
818− <*> parseJSON (V.unsafeIndex abcde 4)
820+ then (,,,,) <$> parseJSONElemAtIndex 0 abcde
821+ <*> parseJSONElemAtIndex 1 abcde
822+ <*> parseJSONElemAtIndex 2 abcde
823+ <*> parseJSONElemAtIndex 3 abcde
824+ <*> parseJSONElemAtIndex 4 abcde
819825 else fail $ "cannot unpack array of length " ++
820826 show n ++ " into a 5-tuple"
821827 {-# INLINE parseJSON #-}
@@ -846,12 +852,12 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
846852 parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->
847853 let n = V.length abcdef
848854 in if n == 6
849− then (,,,,,) <$> parseJSON (V.unsafeIndex abcdef 0)
850− <*> parseJSON (V.unsafeIndex abcdef 1)
851− <*> parseJSON (V.unsafeIndex abcdef 2)
852− <*> parseJSON (V.unsafeIndex abcdef 3)
853− <*> parseJSON (V.unsafeIndex abcdef 4)
854− <*> parseJSON (V.unsafeIndex abcdef 5)
855+ then (,,,,,) <$> parseJSONElemAtIndex 0 abcdef
856+ <*> parseJSONElemAtIndex 1 abcdef
857+ <*> parseJSONElemAtIndex 2 abcdef
858+ <*> parseJSONElemAtIndex 3 abcdef
859+ <*> parseJSONElemAtIndex 4 abcdef
860+ <*> parseJSONElemAtIndex 5 abcdef
855861 else fail $ "cannot unpack array of length " ++
856862 show n ++ " into a 6-tuple"
857863 {-# INLINE parseJSON #-}
@@ -884,13 +890,13 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
884890 parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->
885891 let n = V.length abcdefg
886892 in if n == 7
887− then (,,,,,,) <$> parseJSON (V.unsafeIndex abcdefg 0)
888− <*> parseJSON (V.unsafeIndex abcdefg 1)
889− <*> parseJSON (V.unsafeIndex abcdefg 2)
890− <*> parseJSON (V.unsafeIndex abcdefg 3)
891− <*> parseJSON (V.unsafeIndex abcdefg 4)
892− <*> parseJSON (V.unsafeIndex abcdefg 5)
893− <*> parseJSON (V.unsafeIndex abcdefg 6)
893+ then (,,,,,,) <$> parseJSONElemAtIndex 0 abcdefg
894+ <*> parseJSONElemAtIndex 1 abcdefg
895+ <*> parseJSONElemAtIndex 2 abcdefg
896+ <*> parseJSONElemAtIndex 3 abcdefg
897+ <*> parseJSONElemAtIndex 4 abcdefg
898+ <*> parseJSONElemAtIndex 5 abcdefg
899+ <*> parseJSONElemAtIndex 6 abcdefg
894900 else fail $ "cannot unpack array of length " ++
895901 show n ++ " into a 7-tuple"
896902 {-# INLINE parseJSON #-}
@@ -929,14 +935,14 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
929935 then fail $ "cannot unpack array of length " ++
930936 show n ++ " into an 8-tuple"
931937 else (,,,,,,,)
932− <$> parseJSON (V.unsafeIndex ary 0)
933− <*> parseJSON (V.unsafeIndex ary 1)
934− <*> parseJSON (V.unsafeIndex ary 2)
935− <*> parseJSON (V.unsafeIndex ary 3)
936− <*> parseJSON (V.unsafeIndex ary 4)
937− <*> parseJSON (V.unsafeIndex ary 5)
938− <*> parseJSON (V.unsafeIndex ary 6)
939− <*> parseJSON (V.unsafeIndex ary 7)
938+ <$> parseJSONElemAtIndex 0 ary
939+ <*> parseJSONElemAtIndex 1 ary
940+ <*> parseJSONElemAtIndex 2 ary
941+ <*> parseJSONElemAtIndex 3 ary
942+ <*> parseJSONElemAtIndex 4 ary
943+ <*> parseJSONElemAtIndex 5 ary
944+ <*> parseJSONElemAtIndex 6 ary
945+ <*> parseJSONElemAtIndex 7 ary
940946 {-# INLINE parseJSON #-}
941947
942948instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -975,15 +981,15 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
975981 then fail $ "cannot unpack array of length " ++
976982 show n ++ " into a 9-tuple"
977983 else (,,,,,,,,)
978− <$> parseJSON (V.unsafeIndex ary 0)
979− <*> parseJSON (V.unsafeIndex ary 1)
980− <*> parseJSON (V.unsafeIndex ary 2)
981− <*> parseJSON (V.unsafeIndex ary 3)
982− <*> parseJSON (V.unsafeIndex ary 4)
983− <*> parseJSON (V.unsafeIndex ary 5)
984− <*> parseJSON (V.unsafeIndex ary 6)
985− <*> parseJSON (V.unsafeIndex ary 7)
986− <*> parseJSON (V.unsafeIndex ary 8)
984+ <$> parseJSONElemAtIndex 0 ary
985+ <*> parseJSONElemAtIndex 1 ary
986+ <*> parseJSONElemAtIndex 2 ary
987+ <*> parseJSONElemAtIndex 3 ary
988+ <*> parseJSONElemAtIndex 4 ary
989+ <*> parseJSONElemAtIndex 5 ary
990+ <*> parseJSONElemAtIndex 6 ary
991+ <*> parseJSONElemAtIndex 7 ary
992+ <*> parseJSONElemAtIndex 8 ary
987993 {-# INLINE parseJSON #-}
988994
989995instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1025,16 +1031,16 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
10251031 then fail $ "cannot unpack array of length " ++
10261032 show n ++ " into a 10-tuple"
10271033 else (,,,,,,,,,)
1028− <$> parseJSON (V.unsafeIndex ary 0)
1029− <*> parseJSON (V.unsafeIndex ary 1)
1030− <*> parseJSON (V.unsafeIndex ary 2)
1031− <*> parseJSON (V.unsafeIndex ary 3)
1032− <*> parseJSON (V.unsafeIndex ary 4)
1033− <*> parseJSON (V.unsafeIndex ary 5)
1034− <*> parseJSON (V.unsafeIndex ary 6)
1035− <*> parseJSON (V.unsafeIndex ary 7)
1036− <*> parseJSON (V.unsafeIndex ary 8)
1037− <*> parseJSON (V.unsafeIndex ary 9)
1034+ <$> parseJSONElemAtIndex 0 ary
1035+ <*> parseJSONElemAtIndex 1 ary
1036+ <*> parseJSONElemAtIndex 2 ary
1037+ <*> parseJSONElemAtIndex 3 ary
1038+ <*> parseJSONElemAtIndex 4 ary
1039+ <*> parseJSONElemAtIndex 5 ary
1040+ <*> parseJSONElemAtIndex 6 ary
1041+ <*> parseJSONElemAtIndex 7 ary
1042+ <*> parseJSONElemAtIndex 8 ary
1043+ <*> parseJSONElemAtIndex 9 ary
10381044 {-# INLINE parseJSON #-}
10391045
10401046instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1079,17 +1085,17 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
10791085 then fail $ "cannot unpack array of length " ++
10801086 show n ++ " into an 11-tuple"
10811087 else (,,,,,,,,,,)
1082− <$> parseJSON (V.unsafeIndex ary 0)
1083− <*> parseJSON (V.unsafeIndex ary 1)
1084− <*> parseJSON (V.unsafeIndex ary 2)
1085− <*> parseJSON (V.unsafeIndex ary 3)
1086− <*> parseJSON (V.unsafeIndex ary 4)
1087− <*> parseJSON (V.unsafeIndex ary 5)
1088− <*> parseJSON (V.unsafeIndex ary 6)
1089− <*> parseJSON (V.unsafeIndex ary 7)
1090− <*> parseJSON (V.unsafeIndex ary 8)
1091− <*> parseJSON (V.unsafeIndex ary 9)
1092− <*> parseJSON (V.unsafeIndex ary 10)
1088+ <$> parseJSONElemAtIndex 0 ary
1089+ <*> parseJSONElemAtIndex 1 ary
1090+ <*> parseJSONElemAtIndex 2 ary
1091+ <*> parseJSONElemAtIndex 3 ary
1092+ <*> parseJSONElemAtIndex 4 ary
1093+ <*> parseJSONElemAtIndex 5 ary
1094+ <*> parseJSONElemAtIndex 6 ary
1095+ <*> parseJSONElemAtIndex 7 ary
1096+ <*> parseJSONElemAtIndex 8 ary
1097+ <*> parseJSONElemAtIndex 9 ary
1098+ <*> parseJSONElemAtIndex 10 ary
10931099 {-# INLINE parseJSON #-}
10941100
10951101instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1136,18 +1142,18 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
11361142 then fail $ "cannot unpack array of length " ++
11371143 show n ++ " into a 12-tuple"
11381144 else (,,,,,,,,,,,)
1139− <$> parseJSON (V.unsafeIndex ary 0)
1140− <*> parseJSON (V.unsafeIndex ary 1)
1141− <*> parseJSON (V.unsafeIndex ary 2)
1142− <*> parseJSON (V.unsafeIndex ary 3)
1143− <*> parseJSON (V.unsafeIndex ary 4)
1144− <*> parseJSON (V.unsafeIndex ary 5)
1145− <*> parseJSON (V.unsafeIndex ary 6)
1146− <*> parseJSON (V.unsafeIndex ary 7)
1147− <*> parseJSON (V.unsafeIndex ary 8)
1148− <*> parseJSON (V.unsafeIndex ary 9)
1149− <*> parseJSON (V.unsafeIndex ary 10)
1150− <*> parseJSON (V.unsafeIndex ary 11)
1145+ <$> parseJSONElemAtIndex 0 ary
1146+ <*> parseJSONElemAtIndex 1 ary
1147+ <*> parseJSONElemAtIndex 2 ary
1148+ <*> parseJSONElemAtIndex 3 ary
1149+ <*> parseJSONElemAtIndex 4 ary
1150+ <*> parseJSONElemAtIndex 5 ary
1151+ <*> parseJSONElemAtIndex 6 ary
1152+ <*> parseJSONElemAtIndex 7 ary
1153+ <*> parseJSONElemAtIndex 8 ary
1154+ <*> parseJSONElemAtIndex 9 ary
1155+ <*> parseJSONElemAtIndex 10 ary
1156+ <*> parseJSONElemAtIndex 11 ary
11511157 {-# INLINE parseJSON #-}
11521158
11531159instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1197,19 +1203,19 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
11971203 then fail $ "cannot unpack array of length " ++
11981204 show n ++ " into a 13-tuple"
11991205 else (,,,,,,,,,,,,)
1200− <$> parseJSON (V.unsafeIndex ary 0)
1201− <*> parseJSON (V.unsafeIndex ary 1)
1202− <*> parseJSON (V.unsafeIndex ary 2)
1203− <*> parseJSON (V.unsafeIndex ary 3)
1204− <*> parseJSON (V.unsafeIndex ary 4)
1205− <*> parseJSON (V.unsafeIndex ary 5)
1206− <*> parseJSON (V.unsafeIndex ary 6)
1207− <*> parseJSON (V.unsafeIndex ary 7)
1208− <*> parseJSON (V.unsafeIndex ary 8)
1209− <*> parseJSON (V.unsafeIndex ary 9)
1210− <*> parseJSON (V.unsafeIndex ary 10)
1211− <*> parseJSON (V.unsafeIndex ary 11)
1212− <*> parseJSON (V.unsafeIndex ary 12)
1206+ <$> parseJSONElemAtIndex 0 ary
1207+ <*> parseJSONElemAtIndex 1 ary
1208+ <*> parseJSONElemAtIndex 2 ary
1209+ <*> parseJSONElemAtIndex 3 ary
1210+ <*> parseJSONElemAtIndex 4 ary
1211+ <*> parseJSONElemAtIndex 5 ary
1212+ <*> parseJSONElemAtIndex 6 ary
1213+ <*> parseJSONElemAtIndex 7 ary
1214+ <*> parseJSONElemAtIndex 8 ary
1215+ <*> parseJSONElemAtIndex 9 ary
1216+ <*> parseJSONElemAtIndex 10 ary
1217+ <*> parseJSONElemAtIndex 11 ary
1218+ <*> parseJSONElemAtIndex 12 ary
12131219 {-# INLINE parseJSON #-}
12141220
12151221instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1261,20 +1267,20 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
12611267 then fail $ "cannot unpack array of length " ++
12621268 show n ++ " into a 14-tuple"
12631269 else (,,,,,,,,,,,,,)
1264− <$> parseJSON (V.unsafeIndex ary 0)
1265− <*> parseJSON (V.unsafeIndex ary 1)
1266− <*> parseJSON (V.unsafeIndex ary 2)
1267− <*> parseJSON (V.unsafeIndex ary 3)
1268− <*> parseJSON (V.unsafeIndex ary 4)
1269− <*> parseJSON (V.unsafeIndex ary 5)
1270− <*> parseJSON (V.unsafeIndex ary 6)
1271− <*> parseJSON (V.unsafeIndex ary 7)
1272− <*> parseJSON (V.unsafeIndex ary 8)
1273− <*> parseJSON (V.unsafeIndex ary 9)
1274− <*> parseJSON (V.unsafeIndex ary 10)
1275− <*> parseJSON (V.unsafeIndex ary 11)
1276− <*> parseJSON (V.unsafeIndex ary 12)
1277− <*> parseJSON (V.unsafeIndex ary 13)
1270+ <$> parseJSONElemAtIndex 0 ary
1271+ <*> parseJSONElemAtIndex 1 ary
1272+ <*> parseJSONElemAtIndex 2 ary
1273+ <*> parseJSONElemAtIndex 3 ary
1274+ <*> parseJSONElemAtIndex 4 ary
1275+ <*> parseJSONElemAtIndex 5 ary
1276+ <*> parseJSONElemAtIndex 6 ary
1277+ <*> parseJSONElemAtIndex 7 ary
1278+ <*> parseJSONElemAtIndex 8 ary
1279+ <*> parseJSONElemAtIndex 9 ary
1280+ <*> parseJSONElemAtIndex 10 ary
1281+ <*> parseJSONElemAtIndex 11 ary
1282+ <*> parseJSONElemAtIndex 12 ary
1283+ <*> parseJSONElemAtIndex 13 ary
12781284 {-# INLINE parseJSON #-}
12791285
12801286instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,
@@ -1328,21 +1334,21 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
13281334 then fail $ "cannot unpack array of length " ++
13291335 show n ++ " into a 15-tuple"
13301336 else (,,,,,,,,,,,,,,)
1331− <$> parseJSON (V.unsafeIndex ary 0)
1332− <*> parseJSON (V.unsafeIndex ary 1)
1333− <*> parseJSON (V.unsafeIndex ary 2)
1334− <*> parseJSON (V.unsafeIndex ary 3)
1335− <*> parseJSON (V.unsafeIndex ary 4)
1336− <*> parseJSON (V.unsafeIndex ary 5)
1337− <*> parseJSON (V.unsafeIndex ary 6)
1338− <*> parseJSON (V.unsafeIndex ary 7)
1339− <*> parseJSON (V.unsafeIndex ary 8)
1340− <*> parseJSON (V.unsafeIndex ary 9)
1341− <*> parseJSON (V.unsafeIndex ary 10)
1342− <*> parseJSON (V.unsafeIndex ary 11)
1343− <*> parseJSON (V.unsafeIndex ary 12)
1344− <*> parseJSON (V.unsafeIndex ary 13)
1345− <*> parseJSON (V.unsafeIndex ary 14)
1337+ <$> parseJSONElemAtIndex 0 ary
1338+ <*> parseJSONElemAtIndex 1 ary
1339+ <*> parseJSONElemAtIndex 2 ary
1340+ <*> parseJSONElemAtIndex 3 ary
1341+ <*> parseJSONElemAtIndex 4 ary
1342+ <*> parseJSONElemAtIndex 5 ary
1343+ <*> parseJSONElemAtIndex 6 ary
1344+ <*> parseJSONElemAtIndex 7 ary
1345+ <*> parseJSONElemAtIndex 8 ary
1346+ <*> parseJSONElemAtIndex 9 ary
1347+ <*> parseJSONElemAtIndex 10 ary
1348+ <*> parseJSONElemAtIndex 11 ary
1349+ <*> parseJSONElemAtIndex 12 ary
1350+ <*> parseJSONElemAtIndex 13 ary
1351+ <*> parseJSONElemAtIndex 14 ary
13461352 {-# INLINE parseJSON #-}
13471353
13481354instance ToJSON a => ToJSON (Dual a) where
@@ -1437,7 +1443,7 @@ fromJSON = parse parseJSON
14371443(.:) :: (FromJSON a) => Object -> Text -> Parser a
14381444obj .: key = case H.lookup key obj of
14391445 Nothing -> fail $ "key " ++ show key ++ " not present"
1440− Just v -> parseJSON v
1446+ Just v -> parseJSON v <?> Key key
14411447{-# INLINE (.:) #-}
14421448
14431449-- | Retrieve the value associated with the given key of an 'Object'.
@@ -1450,7 +1456,7 @@ obj .: key = case H.lookup key obj of
14501456(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
14511457obj .:? key = case H.lookup key obj of
14521458 Nothing -> pure Nothing
1453− Just v -> parseJSON v
1459+ Just v -> parseJSON v <?> Key key
14541460{-# INLINE (.:?) #-}
14551461
14561462-- | 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 "" }