702a0da · typeable/aeson

git.iko.soy/typeable/aeson

Add json path to parse error messages

Every time you parse some JSON and get error message, it is very painful to track where the error is because existing error messages do not point to the place in JSON where parse error occured. JSON syntax errors are reported from Attoparsec parser and it gives position. But JSON conversion errors have no support for tracking position/context so quality of error messages is poor. This change adds json path to error message: 1. Parser tracks current JSON path (in reverse order) 2. An <?> operation is added to annotate Parser with JSON context (JSON path). This operation is named after Attoparsec's <?> which serves similar purpose. 3. Built-in FromJSON instances are updated to provide context information 4. .: and .:? operations automatically add context information. Context is reported in form of JSON-Path expression e.g. $.store.book[0].title: > eitherDecode storeJsonString :: Either String Store Left "Error in \"$.store.book[0]\": key \"title\" not present" Caveats: 1. There is no tests for error message yet. I believe those should be done in normal xUnit assertion style instead of QuickCheck property style. 2. Only first error is reported. Further work can include supporting collection of error messages and reporting all of them at once. This can be useful e.g. for validating HTTP JSON requests and reporting all errors at once for displaying them to user on a web form.

commit702a0da99a82ca3c9603d175b0fa8e01dfb4c360 authorMaxim Kulkin <mkulkin@mirantis.com> dateFri 7 Nov 2014, 14:24 (12 years ago) parent838a626

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 "" }