b6a64fc · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #220 from maximkulkin/json-path-error-reporting

b6a64fcBryan O'Sullivan11 years ago

Data/Aeson.hs+8−4

compare with master

unifiedsplit

@@ -141,24 +141,28 @@ decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a

141decodeStrict' = decodeStrictWith jsonEOF' fromJSON

142{-# INLINE decodeStrict' #-}

143

144+eitherFormatError :: Either (JSONPath, String) a -> Either String a

145+eitherFormatError = either (Left . uncurry formatError) Right

146+{-# INLINE eitherFormatError #-}

147+

144-- | Like 'decode' but returns an error message when decoding fails.

148-- | Like 'decode' but returns an error message when decoding fails.

145eitherDecode :: (FromJSON a) => L.ByteString -> Either String a

149eitherDecode :: (FromJSON a) => L.ByteString -> Either String a

146−eitherDecode = eitherDecodeWith jsonEOF fromJSON

150+eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF fromJSON

147{-# INLINE eitherDecode #-}

151{-# INLINE eitherDecode #-}

148

152

149-- | Like 'decodeStrict' but returns an error message when decoding fails.

153-- | Like 'decodeStrict' but returns an error message when decoding fails.

150eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a

154eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a

151−eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON

155+eitherDecodeStrict = eitherFormatError . eitherDecodeStrictWith jsonEOF fromJSON

152{-# INLINE eitherDecodeStrict #-}

156{-# INLINE eitherDecodeStrict #-}

153

157

154-- | Like 'decode'' but returns an error message when decoding fails.

158-- | Like 'decode'' but returns an error message when decoding fails.

155eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a

159eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a

156−eitherDecode' = eitherDecodeWith jsonEOF' fromJSON

160+eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' fromJSON

157{-# INLINE eitherDecode' #-}

161{-# INLINE eitherDecode' #-}

158

162

159-- | Like 'decodeStrict'' but returns an error message when decoding fails.

163-- | Like 'decodeStrict'' but returns an error message when decoding fails.

160eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a

164eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a

161−eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON

165+eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' fromJSON

162{-# INLINE eitherDecodeStrict' #-}

166{-# INLINE eitherDecodeStrict' #-}

163

167

164-- $use

168-- $use

Data/Aeson/Parser/Internal.hs+12−12

@@ -30,7 +30,7 @@ module Data.Aeson.Parser.Internal

31import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)

32import Control.Monad.IO.Class (liftIO)

33−import Data.Aeson.Types (Result(..), Value(..))

33+import Data.Aeson.Types (JSONPath, Result(..), Value(..))

34import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,

35 skipSpace, string)

36import Data.Bits ((.|.), shiftL)

@@ -287,27 +287,27 @@ decodeWith p to s =

287decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString

288 -> Maybe a

289decodeStrictWith p to s =

290− case either Error to (A.parseOnly p s) of

290+ case either (Error []) to (A.parseOnly p s) of

291 Success a -> Just a

292− Error _ -> Nothing

292+ _ -> Nothing

293{-# INLINE decodeStrictWith #-}

294

295eitherDecodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString

296− -> Either String a

296+ -> Either (JSONPath, String) a

297eitherDecodeWith p to s =

298 case L.parse p s of

299− L.Done _ v -> case to v of

299+ L.Done _ v -> case to v of

300− Success a -> Right a

300+ Success a -> Right a

301− Error msg -> Left msg

301+ Error path msg -> Left (path, msg)

302− L.Fail _ _ msg -> Left msg

302+ L.Fail _ _ msg -> Left ([], msg)

303{-# INLINE eitherDecodeWith #-}

304

305eitherDecodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString

306− -> Either String a

306+ -> Either (JSONPath, String) a

307eitherDecodeStrictWith p to s =

308− case either Error to (A.parseOnly p s) of

308+ case either (Error []) to (A.parseOnly p s) of

309− Success a -> Right a

309+ Success a -> Right a

310− Error msg -> Left msg

310+ Error path msg -> Left (path, msg)

311{-# INLINE eitherDecodeStrictWith #-}

312

313-- $lazy

Data/Aeson/Types.hs+2

@@ -32,6 +32,8 @@ module Data.Aeson.Types

32 , parseMaybe

33 , ToJSON(..)

34 , modifyFailure

35+ , JSONPath

36+ , formatError

36 -- ** Generic JSON classes

38 -- ** Generic JSON classes

37 , GFromJSON(..)

39 , GFromJSON(..)

Data/Aeson/Types/Instances.hs+133−127

@@ -72,7 +72,7 @@ import Data.Ratio (Ratio, (%), numerator, denominator)

72import Data.Text (Text, pack, unpack)

73import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))

74import Data.Time.Format (FormatTime, formatTime, parseTime)

75−import Data.Traversable (traverse)

75+import Data.Traversable as Tr (sequence, traverse)

76import Data.Vector (Vector)

77import Data.Word (Word, Word8, Word16, Word32, Word64)

78import Foreign.Storable (Storable)

@@ -101,6 +101,9 @@ import Data.Time.Format (defaultTimeLocale, dateTimeFmt)

101import System.Locale (defaultTimeLocale, dateTimeFmt)

102#endif

103

104+parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a

105+parseIndexedJSON idx value = parseJSON value <?> Index idx

106+

104instance (ToJSON a) => ToJSON (Identity a) where

107instance (ToJSON a) => ToJSON (Identity a) where

105 toJSON (Identity a) = toJSON a

108 toJSON (Identity a) = toJSON a

106 {-# INLINE toJSON #-}

109 {-# INLINE toJSON #-}

@@ -420,7 +423,7 @@ instance (ToJSON a) => ToJSON [a] where

420 where commas = P.foldr (\v vs -> B.char7 ',' <> toEncoding v <> vs) mempty

423 where commas = P.foldr (\v vs -> B.char7 ',' <> toEncoding v <> vs) mempty

421

424

422instance (FromJSON a) => FromJSON [a] where

425instance (FromJSON a) => FromJSON [a] where

423− parseJSON = withArray "[a]" $ mapM parseJSON . V.toList

426+ parseJSON = withArray "[a]" $ Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList

424 {-# INLINE parseJSON #-}

427 {-# INLINE parseJSON #-}

425

428

426instance (Foldable t, ToJSON a) => ToJSON (t a) where

429instance (Foldable t, ToJSON a) => ToJSON (t a) where

@@ -448,7 +451,7 @@ encodeVector xs

448 where go v b = B.char7 ',' <> toEncoding v <> b

451 where go v b = B.char7 ',' <> toEncoding v <> b

449

452

450instance (FromJSON a) => FromJSON (Vector a) where

453instance (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

452 {-# INLINE parseJSON #-}

455 {-# INLINE parseJSON #-}

453

456

454vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value

457vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value

@@ -456,7 +459,7 @@ vectorToJSON = Array . V.map toJSON . V.convert

456{-# INLINE vectorToJSON #-}

459{-# INLINE vectorToJSON #-}

457

460

458vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)

461vectorParseJSON :: (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

460{-# INLINE vectorParseJSON #-}

463{-# INLINE vectorParseJSON #-}

461

464

462instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where

465instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where

@@ -563,7 +566,7 @@ encodePair k v = toEncoding k <> B.char7 ':' <> toEncoding v

563

566

564instance (FromJSON v) => FromJSON (M.Map Text v) where

567instance (FromJSON v) => FromJSON (M.Map Text v) where

565 parseJSON = withObject "Map Text a" $

568 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)

567

570

568instance (ToJSON v) => ToJSON (M.Map LT.Text v) where

571instance (ToJSON v) => ToJSON (M.Map LT.Text v) where

569 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

572 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

@@ -588,7 +591,7 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where

588 toEncoding = encodeWithKey H.foldrWithKey

591 toEncoding = encodeWithKey H.foldrWithKey

589

592

590instance (FromJSON v) => FromJSON (H.HashMap Text v) where

593instance (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)

592

595

593instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

596instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

594 toJSON = Object . mapKeyVal LT.toStrict toJSON

597 toJSON = Object . mapKeyVal LT.toStrict toJSON

@@ -711,6 +714,9 @@ instance FromJSON UTCTime where

711 _ -> fail "could not parse ISO-8601 date"

714 _ -> fail "could not parse ISO-8601 date"

712 {-# INLINE parseJSON #-}

715 {-# INLINE parseJSON #-}

713

716

717+parseJSONElemAtIndex :: FromJSON a => Int -> Vector Value -> Parser a

718+parseJSONElemAtIndex idx ary = parseJSON (V.unsafeIndex ary idx) <?> Index idx

719+

714instance (ToJSON a, ToJSON b) => ToJSON (a,b) where

720instance (ToJSON a, ToJSON b) => ToJSON (a,b) where

715 toJSON (a,b) = Array $ V.create $ do

721 toJSON (a,b) = Array $ V.create $ do

716 mv <- VM.unsafeNew 2

722 mv <- VM.unsafeNew 2

@@ -727,8 +733,8 @@ instance (FromJSON a, FromJSON b) => FromJSON (a,b) where

727 parseJSON = withArray "(a,b)" $ \ab ->

733 parseJSON = withArray "(a,b)" $ \ab ->

728 let n = V.length ab

734 let n = V.length ab

729 in if n == 2

735 in if n == 2

730− then (,) <$> parseJSON (V.unsafeIndex ab 0)

736+ then (,) <$> parseJSONElemAtIndex 0 ab

731− <*> parseJSON (V.unsafeIndex ab 1)

737+ <*> parseJSONElemAtIndex 1 ab

732 else fail $ "cannot unpack array of length " ++

738 else fail $ "cannot unpack array of length " ++

733 show n ++ " into a pair"

739 show n ++ " into a pair"

734 {-# INLINE parseJSON #-}

740 {-# INLINE parseJSON #-}

@@ -751,9 +757,9 @@ instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where

751 parseJSON = withArray "(a,b,c)" $ \abc ->

757 parseJSON = withArray "(a,b,c)" $ \abc ->

752 let n = V.length abc

758 let n = V.length abc

753 in if n == 3

759 in if n == 3

754− then (,,) <$> parseJSON (V.unsafeIndex abc 0)

760+ then (,,) <$> parseJSONElemAtIndex 0 abc

755− <*> parseJSON (V.unsafeIndex abc 1)

761+ <*> parseJSONElemAtIndex 1 abc

756− <*> parseJSON (V.unsafeIndex abc 2)

762+ <*> parseJSONElemAtIndex 2 abc

757 else fail $ "cannot unpack array of length " ++

763 else fail $ "cannot unpack array of length " ++

758 show n ++ " into a 3-tuple"

764 show n ++ " into a 3-tuple"

759 {-# INLINE parseJSON #-}

765 {-# INLINE parseJSON #-}

@@ -779,10 +785,10 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>

779 parseJSON = withArray "(a,b,c,d)" $ \abcd ->

785 parseJSON = withArray "(a,b,c,d)" $ \abcd ->

780 let n = V.length abcd

786 let n = V.length abcd

781 in if n == 4

787 in if n == 4

782− then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)

788+ then (,,,) <$> parseJSONElemAtIndex 0 abcd

783− <*> parseJSON (V.unsafeIndex abcd 1)

789+ <*> parseJSONElemAtIndex 1 abcd

784− <*> parseJSON (V.unsafeIndex abcd 2)

790+ <*> parseJSONElemAtIndex 2 abcd

785− <*> parseJSON (V.unsafeIndex abcd 3)

791+ <*> parseJSONElemAtIndex 3 abcd

786 else fail $ "cannot unpack array of length " ++

792 else fail $ "cannot unpack array of length " ++

787 show n ++ " into a 4-tuple"

793 show n ++ " into a 4-tuple"

788 {-# INLINE parseJSON #-}

794 {-# INLINE parseJSON #-}

@@ -811,11 +817,11 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>

811 parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->

817 parseJSON = withArray "(a,b,c,d,e)" $ \abcde ->

812 let n = V.length abcde

818 let n = V.length abcde

813 in if n == 5

819 in if n == 5

814− then (,,,,) <$> parseJSON (V.unsafeIndex abcde 0)

820+ then (,,,,) <$> parseJSONElemAtIndex 0 abcde

815− <*> parseJSON (V.unsafeIndex abcde 1)

821+ <*> parseJSONElemAtIndex 1 abcde

816− <*> parseJSON (V.unsafeIndex abcde 2)

822+ <*> parseJSONElemAtIndex 2 abcde

817− <*> parseJSON (V.unsafeIndex abcde 3)

823+ <*> parseJSONElemAtIndex 3 abcde

818− <*> parseJSON (V.unsafeIndex abcde 4)

824+ <*> parseJSONElemAtIndex 4 abcde

819 else fail $ "cannot unpack array of length " ++

825 else fail $ "cannot unpack array of length " ++

820 show n ++ " into a 5-tuple"

826 show n ++ " into a 5-tuple"

821 {-# INLINE parseJSON #-}

827 {-# INLINE parseJSON #-}

@@ -846,12 +852,12 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

846 parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->

852 parseJSON = withArray "(a,b,c,d,e,f)" $ \abcdef ->

847 let n = V.length abcdef

853 let n = V.length abcdef

848 in if n == 6

854 in if n == 6

849− then (,,,,,) <$> parseJSON (V.unsafeIndex abcdef 0)

855+ then (,,,,,) <$> parseJSONElemAtIndex 0 abcdef

850− <*> parseJSON (V.unsafeIndex abcdef 1)

856+ <*> parseJSONElemAtIndex 1 abcdef

851− <*> parseJSON (V.unsafeIndex abcdef 2)

857+ <*> parseJSONElemAtIndex 2 abcdef

852− <*> parseJSON (V.unsafeIndex abcdef 3)

858+ <*> parseJSONElemAtIndex 3 abcdef

853− <*> parseJSON (V.unsafeIndex abcdef 4)

859+ <*> parseJSONElemAtIndex 4 abcdef

854− <*> parseJSON (V.unsafeIndex abcdef 5)

860+ <*> parseJSONElemAtIndex 5 abcdef

855 else fail $ "cannot unpack array of length " ++

861 else fail $ "cannot unpack array of length " ++

856 show n ++ " into a 6-tuple"

862 show n ++ " into a 6-tuple"

857 {-# INLINE parseJSON #-}

863 {-# INLINE parseJSON #-}

@@ -884,13 +890,13 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

884 parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->

890 parseJSON = withArray "(a,b,c,d,e,f,g)" $ \abcdefg ->

885 let n = V.length abcdefg

891 let n = V.length abcdefg

886 in if n == 7

892 in if n == 7

887− then (,,,,,,) <$> parseJSON (V.unsafeIndex abcdefg 0)

893+ then (,,,,,,) <$> parseJSONElemAtIndex 0 abcdefg

888− <*> parseJSON (V.unsafeIndex abcdefg 1)

894+ <*> parseJSONElemAtIndex 1 abcdefg

889− <*> parseJSON (V.unsafeIndex abcdefg 2)

895+ <*> parseJSONElemAtIndex 2 abcdefg

890− <*> parseJSON (V.unsafeIndex abcdefg 3)

896+ <*> parseJSONElemAtIndex 3 abcdefg

891− <*> parseJSON (V.unsafeIndex abcdefg 4)

897+ <*> parseJSONElemAtIndex 4 abcdefg

892− <*> parseJSON (V.unsafeIndex abcdefg 5)

898+ <*> parseJSONElemAtIndex 5 abcdefg

893− <*> parseJSON (V.unsafeIndex abcdefg 6)

899+ <*> parseJSONElemAtIndex 6 abcdefg

894 else fail $ "cannot unpack array of length " ++

900 else fail $ "cannot unpack array of length " ++

895 show n ++ " into a 7-tuple"

901 show n ++ " into a 7-tuple"

896 {-# INLINE parseJSON #-}

902 {-# INLINE parseJSON #-}

@@ -929,14 +935,14 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

929 then fail $ "cannot unpack array of length " ++

935 then fail $ "cannot unpack array of length " ++

930 show n ++ " into an 8-tuple"

936 show n ++ " into an 8-tuple"

931 else (,,,,,,,)

937 else (,,,,,,,)

932− <$> parseJSON (V.unsafeIndex ary 0)

938+ <$> parseJSONElemAtIndex 0 ary

933− <*> parseJSON (V.unsafeIndex ary 1)

939+ <*> parseJSONElemAtIndex 1 ary

934− <*> parseJSON (V.unsafeIndex ary 2)

940+ <*> parseJSONElemAtIndex 2 ary

935− <*> parseJSON (V.unsafeIndex ary 3)

941+ <*> parseJSONElemAtIndex 3 ary

936− <*> parseJSON (V.unsafeIndex ary 4)

942+ <*> parseJSONElemAtIndex 4 ary

937− <*> parseJSON (V.unsafeIndex ary 5)

943+ <*> parseJSONElemAtIndex 5 ary

938− <*> parseJSON (V.unsafeIndex ary 6)

944+ <*> parseJSONElemAtIndex 6 ary

939− <*> parseJSON (V.unsafeIndex ary 7)

945+ <*> parseJSONElemAtIndex 7 ary

940 {-# INLINE parseJSON #-}

946 {-# INLINE parseJSON #-}

941

947

942instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

948instance (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,

975 then fail $ "cannot unpack array of length " ++

981 then fail $ "cannot unpack array of length " ++

976 show n ++ " into a 9-tuple"

982 show n ++ " into a 9-tuple"

977 else (,,,,,,,,)

983 else (,,,,,,,,)

978− <$> parseJSON (V.unsafeIndex ary 0)

984+ <$> parseJSONElemAtIndex 0 ary

979− <*> parseJSON (V.unsafeIndex ary 1)

985+ <*> parseJSONElemAtIndex 1 ary

980− <*> parseJSON (V.unsafeIndex ary 2)

986+ <*> parseJSONElemAtIndex 2 ary

981− <*> parseJSON (V.unsafeIndex ary 3)

987+ <*> parseJSONElemAtIndex 3 ary

982− <*> parseJSON (V.unsafeIndex ary 4)

988+ <*> parseJSONElemAtIndex 4 ary

983− <*> parseJSON (V.unsafeIndex ary 5)

989+ <*> parseJSONElemAtIndex 5 ary

984− <*> parseJSON (V.unsafeIndex ary 6)

990+ <*> parseJSONElemAtIndex 6 ary

985− <*> parseJSON (V.unsafeIndex ary 7)

991+ <*> parseJSONElemAtIndex 7 ary

986− <*> parseJSON (V.unsafeIndex ary 8)

992+ <*> parseJSONElemAtIndex 8 ary

987 {-# INLINE parseJSON #-}

993 {-# INLINE parseJSON #-}

988

994

989instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

995instance (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,

1025 then fail $ "cannot unpack array of length " ++

1031 then fail $ "cannot unpack array of length " ++

1026 show n ++ " into a 10-tuple"

1032 show n ++ " into a 10-tuple"

1027 else (,,,,,,,,,)

1033 else (,,,,,,,,,)

1028− <$> parseJSON (V.unsafeIndex ary 0)

1034+ <$> parseJSONElemAtIndex 0 ary

1029− <*> parseJSON (V.unsafeIndex ary 1)

1035+ <*> parseJSONElemAtIndex 1 ary

1030− <*> parseJSON (V.unsafeIndex ary 2)

1036+ <*> parseJSONElemAtIndex 2 ary

1031− <*> parseJSON (V.unsafeIndex ary 3)

1037+ <*> parseJSONElemAtIndex 3 ary

1032− <*> parseJSON (V.unsafeIndex ary 4)

1038+ <*> parseJSONElemAtIndex 4 ary

1033− <*> parseJSON (V.unsafeIndex ary 5)

1039+ <*> parseJSONElemAtIndex 5 ary

1034− <*> parseJSON (V.unsafeIndex ary 6)

1040+ <*> parseJSONElemAtIndex 6 ary

1035− <*> parseJSON (V.unsafeIndex ary 7)

1041+ <*> parseJSONElemAtIndex 7 ary

1036− <*> parseJSON (V.unsafeIndex ary 8)

1042+ <*> parseJSONElemAtIndex 8 ary

1037− <*> parseJSON (V.unsafeIndex ary 9)

1043+ <*> parseJSONElemAtIndex 9 ary

1038 {-# INLINE parseJSON #-}

1044 {-# INLINE parseJSON #-}

1039

1045

1040instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

1046instance (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,

1079 then fail $ "cannot unpack array of length " ++

1085 then fail $ "cannot unpack array of length " ++

1080 show n ++ " into an 11-tuple"

1086 show n ++ " into an 11-tuple"

1081 else (,,,,,,,,,,)

1087 else (,,,,,,,,,,)

1082− <$> parseJSON (V.unsafeIndex ary 0)

1088+ <$> parseJSONElemAtIndex 0 ary

1083− <*> parseJSON (V.unsafeIndex ary 1)

1089+ <*> parseJSONElemAtIndex 1 ary

1084− <*> parseJSON (V.unsafeIndex ary 2)

1090+ <*> parseJSONElemAtIndex 2 ary

1085− <*> parseJSON (V.unsafeIndex ary 3)

1091+ <*> parseJSONElemAtIndex 3 ary

1086− <*> parseJSON (V.unsafeIndex ary 4)

1092+ <*> parseJSONElemAtIndex 4 ary

1087− <*> parseJSON (V.unsafeIndex ary 5)

1093+ <*> parseJSONElemAtIndex 5 ary

1088− <*> parseJSON (V.unsafeIndex ary 6)

1094+ <*> parseJSONElemAtIndex 6 ary

1089− <*> parseJSON (V.unsafeIndex ary 7)

1095+ <*> parseJSONElemAtIndex 7 ary

1090− <*> parseJSON (V.unsafeIndex ary 8)

1096+ <*> parseJSONElemAtIndex 8 ary

1091− <*> parseJSON (V.unsafeIndex ary 9)

1097+ <*> parseJSONElemAtIndex 9 ary

1092− <*> parseJSON (V.unsafeIndex ary 10)

1098+ <*> parseJSONElemAtIndex 10 ary

1093 {-# INLINE parseJSON #-}

1099 {-# INLINE parseJSON #-}

1094

1100

1095instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

1101instance (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,

1136 then fail $ "cannot unpack array of length " ++

1142 then fail $ "cannot unpack array of length " ++

1137 show n ++ " into a 12-tuple"

1143 show n ++ " into a 12-tuple"

1138 else (,,,,,,,,,,,)

1144 else (,,,,,,,,,,,)

1139− <$> parseJSON (V.unsafeIndex ary 0)

1145+ <$> parseJSONElemAtIndex 0 ary

1140− <*> parseJSON (V.unsafeIndex ary 1)

1146+ <*> parseJSONElemAtIndex 1 ary

1141− <*> parseJSON (V.unsafeIndex ary 2)

1147+ <*> parseJSONElemAtIndex 2 ary

1142− <*> parseJSON (V.unsafeIndex ary 3)

1148+ <*> parseJSONElemAtIndex 3 ary

1143− <*> parseJSON (V.unsafeIndex ary 4)

1149+ <*> parseJSONElemAtIndex 4 ary

1144− <*> parseJSON (V.unsafeIndex ary 5)

1150+ <*> parseJSONElemAtIndex 5 ary

1145− <*> parseJSON (V.unsafeIndex ary 6)

1151+ <*> parseJSONElemAtIndex 6 ary

1146− <*> parseJSON (V.unsafeIndex ary 7)

1152+ <*> parseJSONElemAtIndex 7 ary

1147− <*> parseJSON (V.unsafeIndex ary 8)

1153+ <*> parseJSONElemAtIndex 8 ary

1148− <*> parseJSON (V.unsafeIndex ary 9)

1154+ <*> parseJSONElemAtIndex 9 ary

1149− <*> parseJSON (V.unsafeIndex ary 10)

1155+ <*> parseJSONElemAtIndex 10 ary

1150− <*> parseJSON (V.unsafeIndex ary 11)

1156+ <*> parseJSONElemAtIndex 11 ary

1151 {-# INLINE parseJSON #-}

1157 {-# INLINE parseJSON #-}

1152

1158

1153instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

1159instance (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,

1197 then fail $ "cannot unpack array of length " ++

1203 then fail $ "cannot unpack array of length " ++

1198 show n ++ " into a 13-tuple"

1204 show n ++ " into a 13-tuple"

1199 else (,,,,,,,,,,,,)

1205 else (,,,,,,,,,,,,)

1200− <$> parseJSON (V.unsafeIndex ary 0)

1206+ <$> parseJSONElemAtIndex 0 ary

1201− <*> parseJSON (V.unsafeIndex ary 1)

1207+ <*> parseJSONElemAtIndex 1 ary

1202− <*> parseJSON (V.unsafeIndex ary 2)

1208+ <*> parseJSONElemAtIndex 2 ary

1203− <*> parseJSON (V.unsafeIndex ary 3)

1209+ <*> parseJSONElemAtIndex 3 ary

1204− <*> parseJSON (V.unsafeIndex ary 4)

1210+ <*> parseJSONElemAtIndex 4 ary

1205− <*> parseJSON (V.unsafeIndex ary 5)

1211+ <*> parseJSONElemAtIndex 5 ary

1206− <*> parseJSON (V.unsafeIndex ary 6)

1212+ <*> parseJSONElemAtIndex 6 ary

1207− <*> parseJSON (V.unsafeIndex ary 7)

1213+ <*> parseJSONElemAtIndex 7 ary

1208− <*> parseJSON (V.unsafeIndex ary 8)

1214+ <*> parseJSONElemAtIndex 8 ary

1209− <*> parseJSON (V.unsafeIndex ary 9)

1215+ <*> parseJSONElemAtIndex 9 ary

1210− <*> parseJSON (V.unsafeIndex ary 10)

1216+ <*> parseJSONElemAtIndex 10 ary

1211− <*> parseJSON (V.unsafeIndex ary 11)

1217+ <*> parseJSONElemAtIndex 11 ary

1212− <*> parseJSON (V.unsafeIndex ary 12)

1218+ <*> parseJSONElemAtIndex 12 ary

1213 {-# INLINE parseJSON #-}

1219 {-# INLINE parseJSON #-}

1214

1220

1215instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

1221instance (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,

1261 then fail $ "cannot unpack array of length " ++

1267 then fail $ "cannot unpack array of length " ++

1262 show n ++ " into a 14-tuple"

1268 show n ++ " into a 14-tuple"

1263 else (,,,,,,,,,,,,,)

1269 else (,,,,,,,,,,,,,)

1264− <$> parseJSON (V.unsafeIndex ary 0)

1270+ <$> parseJSONElemAtIndex 0 ary

1265− <*> parseJSON (V.unsafeIndex ary 1)

1271+ <*> parseJSONElemAtIndex 1 ary

1266− <*> parseJSON (V.unsafeIndex ary 2)

1272+ <*> parseJSONElemAtIndex 2 ary

1267− <*> parseJSON (V.unsafeIndex ary 3)

1273+ <*> parseJSONElemAtIndex 3 ary

1268− <*> parseJSON (V.unsafeIndex ary 4)

1274+ <*> parseJSONElemAtIndex 4 ary

1269− <*> parseJSON (V.unsafeIndex ary 5)

1275+ <*> parseJSONElemAtIndex 5 ary

1270− <*> parseJSON (V.unsafeIndex ary 6)

1276+ <*> parseJSONElemAtIndex 6 ary

1271− <*> parseJSON (V.unsafeIndex ary 7)

1277+ <*> parseJSONElemAtIndex 7 ary

1272− <*> parseJSON (V.unsafeIndex ary 8)

1278+ <*> parseJSONElemAtIndex 8 ary

1273− <*> parseJSON (V.unsafeIndex ary 9)

1279+ <*> parseJSONElemAtIndex 9 ary

1274− <*> parseJSON (V.unsafeIndex ary 10)

1280+ <*> parseJSONElemAtIndex 10 ary

1275− <*> parseJSON (V.unsafeIndex ary 11)

1281+ <*> parseJSONElemAtIndex 11 ary

1276− <*> parseJSON (V.unsafeIndex ary 12)

1282+ <*> parseJSONElemAtIndex 12 ary

1277− <*> parseJSON (V.unsafeIndex ary 13)

1283+ <*> parseJSONElemAtIndex 13 ary

1278 {-# INLINE parseJSON #-}

1284 {-# INLINE parseJSON #-}

1279

1285

1280instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

1286instance (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,

1328 then fail $ "cannot unpack array of length " ++

1334 then fail $ "cannot unpack array of length " ++

1329 show n ++ " into a 15-tuple"

1335 show n ++ " into a 15-tuple"

1330 else (,,,,,,,,,,,,,,)

1336 else (,,,,,,,,,,,,,,)

1331− <$> parseJSON (V.unsafeIndex ary 0)

1337+ <$> parseJSONElemAtIndex 0 ary

1332− <*> parseJSON (V.unsafeIndex ary 1)

1338+ <*> parseJSONElemAtIndex 1 ary

1333− <*> parseJSON (V.unsafeIndex ary 2)

1339+ <*> parseJSONElemAtIndex 2 ary

1334− <*> parseJSON (V.unsafeIndex ary 3)

1340+ <*> parseJSONElemAtIndex 3 ary

1335− <*> parseJSON (V.unsafeIndex ary 4)

1341+ <*> parseJSONElemAtIndex 4 ary

1336− <*> parseJSON (V.unsafeIndex ary 5)

1342+ <*> parseJSONElemAtIndex 5 ary

1337− <*> parseJSON (V.unsafeIndex ary 6)

1343+ <*> parseJSONElemAtIndex 6 ary

1338− <*> parseJSON (V.unsafeIndex ary 7)

1344+ <*> parseJSONElemAtIndex 7 ary

1339− <*> parseJSON (V.unsafeIndex ary 8)

1345+ <*> parseJSONElemAtIndex 8 ary

1340− <*> parseJSON (V.unsafeIndex ary 9)

1346+ <*> parseJSONElemAtIndex 9 ary

1341− <*> parseJSON (V.unsafeIndex ary 10)

1347+ <*> parseJSONElemAtIndex 10 ary

1342− <*> parseJSON (V.unsafeIndex ary 11)

1348+ <*> parseJSONElemAtIndex 11 ary

1343− <*> parseJSON (V.unsafeIndex ary 12)

1349+ <*> parseJSONElemAtIndex 12 ary

1344− <*> parseJSON (V.unsafeIndex ary 13)

1350+ <*> parseJSONElemAtIndex 13 ary

1345− <*> parseJSON (V.unsafeIndex ary 14)

1351+ <*> parseJSONElemAtIndex 14 ary

1346 {-# INLINE parseJSON #-}

1352 {-# INLINE parseJSON #-}

1347

1353

1348instance ToJSON a => ToJSON (Dual a) where

1354instance ToJSON a => ToJSON (Dual a) where

@@ -1437,7 +1443,7 @@ fromJSON = parse parseJSON

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

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

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

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

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

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

1440− Just v -> parseJSON v

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

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

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

1442

1448

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

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

@@ -1450,7 +1456,7 @@ obj .: key = case H.lookup key obj of

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

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

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

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

1452 Nothing -> pure Nothing

1458 Nothing -> pure Nothing

1453− Just v -> parseJSON v

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

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

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

1455

1461

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

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

25 -- * Type conversion

26 , Parser

27 , Result(..)

28+ , JSONPathElement(..)

29+ , JSONPath

28 , parse

30 , parse

29 , parseEither

31 , parseEither

30 , parseMaybe

32 , parseMaybe

31 , modifyFailure

33 , modifyFailure

34+ , formatError

35+ , (<?>)

32 -- * Constructors and accessors

36 -- * Constructors and accessors

33 , object

37 , object

@@ -56,7 +60,7 @@ import Data.Data (Data)

56import Data.HashMap.Strict (HashMap)

60import Data.HashMap.Strict (HashMap)

57import Data.Monoid (Monoid(..), (<>))

61import Data.Monoid (Monoid(..), (<>))

58import Data.String (IsString(..))

62import Data.String (IsString(..))

59−import Data.Text (Text, pack)

63+import Data.Text (Text, pack, unpack)

60import Data.Time (UTCTime)

64import Data.Time (UTCTime)

61import Data.Time.Format (FormatTime)

65import Data.Time.Format (FormatTime)

62import Data.Typeable (Typeable)

66import Data.Typeable (Typeable)

@@ -64,25 +68,37 @@ import Data.Vector (Vector)

64import qualified Data.HashMap.Strict as H

68import qualified Data.HashMap.Strict as H

65import qualified Data.Vector as V

69import qualified Data.Vector as V

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+

67-- | The result of running a 'Parser'.

79-- | The result of running a 'Parser'.

68−data Result a = Error String

80+data Result a = Error JSONPath String

69 | Success a

81 | Success a

70 deriving (Eq, Show, Typeable)

82 deriving (Eq, Show, Typeable)

84+instance NFData JSONPathElement where

85+ rnf (Key t) = rnf t

86+ rnf (Index i) = rnf i

87+

72instance (NFData a) => NFData (Result a) where

88instance (NFData a) => NFData (Result a) where

73 rnf (Success a) = rnf a

89 rnf (Success a) = rnf a

74− rnf (Error err) = rnf err

90+ rnf (Error path err) = rnf path `seq` rnf err

76instance Functor Result where

92instance Functor Result where

77 fmap f (Success a) = Success (f a)

93 fmap f (Success a) = Success (f a)

78− fmap _ (Error err) = Error err

94+ fmap _ (Error path err) = Error path err

79 {-# INLINE fmap #-}

95 {-# INLINE fmap #-}

81instance Monad Result where

97instance Monad Result where

82 return = Success

98 return = Success

83 {-# INLINE return #-}

99 {-# INLINE return #-}

84− Success a >>= k = k a

100+ Success a >>= k = k a

85− Error err >>= _ = Error err

101+ Error path err >>= _ = Error path err

86 {-# INLINE (>>=) #-}

102 {-# INLINE (>>=) #-}

103

88instance Applicative Result where

104instance Applicative Result where

@@ -111,30 +127,31 @@ instance Monoid (Result a) where

111 {-# INLINE mappend #-}

127 {-# INLINE mappend #-}

112

128

113-- | Failure continuation.

129-- | Failure continuation.

114−type Failure f r = String -> f r

130+type Failure f r = JSONPath -> String -> f r

115-- | Success continuation.

131-- | Success continuation.

116type Success a f r = a -> f r

132type Success a f r = a -> f r

117

133

118-- | A continuation-based parser type.

134-- | A continuation-based parser type.

119newtype Parser a = Parser {

135newtype Parser a = Parser {

120 runParser :: forall f r.

136 runParser :: forall f r.

137+ JSONPath

121− Failure f r

138+ -> Failure f r

122 -> Success a f r

139 -> Success a f r

123 -> f r

140 -> f r

124 }

141 }

125

142

126instance Monad Parser where

143instance Monad Parser where

127− m >>= g = Parser $ \kf ks -> let ks' a = runParser (g a) kf ks

144+ m >>= g = Parser $ \path kf ks -> let ks' a = runParser (g a) path kf ks

128− in runParser m kf ks'

145+ in runParser m path kf ks'

129 {-# INLINE (>>=) #-}

146 {-# INLINE (>>=) #-}

130− return a = Parser $ \_kf ks -> ks a

147+ return a = Parser $ \_path _kf ks -> ks a

131 {-# INLINE return #-}

148 {-# INLINE return #-}

132− fail msg = Parser $ \kf _ks -> kf msg

149+ fail msg = Parser $ \path kf _ks -> kf (reverse path) msg

133 {-# INLINE fail #-}

150 {-# INLINE fail #-}

134

151

135instance Functor Parser where

152instance Functor Parser where

136− fmap f m = Parser $ \kf ks -> let ks' a = ks (f a)

153+ fmap f m = Parser $ \path kf ks -> let ks' a = ks (f a)

137− in runParser m kf ks'

154+ in runParser m path kf ks'

138 {-# INLINE fmap #-}

155 {-# INLINE fmap #-}

139

156

140instance Applicative Parser where

157instance Applicative Parser where

@@ -152,8 +169,8 @@ instance Alternative Parser where

152instance MonadPlus Parser where

169instance MonadPlus Parser where

153 mzero = fail "mzero"

170 mzero = fail "mzero"

154 {-# INLINE mzero #-}

171 {-# INLINE mzero #-}

155− mplus a b = Parser $ \kf ks -> let kf' _ = runParser b kf ks

172+ mplus a b = Parser $ \path kf ks -> let kf' _ _ = runParser b path kf ks

156− in runParser a kf' ks

173+ in runParser a path kf' ks

157 {-# INLINE mplus #-}

174 {-# INLINE mplus #-}

158

175

159instance Monoid (Parser a) where

176instance Monoid (Parser a) where

@@ -252,19 +269,29 @@ emptyObject = Object H.empty

252

269

253-- | Run a 'Parser'.

270-- | Run a 'Parser'.

254parse :: (a -> Parser b) -> a -> Result b

271parse :: (a -> Parser b) -> a -> Result b

255−parse m v = runParser (m v) Error Success

272+parse m v = runParser (m v) [] Error Success

256{-# INLINE parse #-}

273{-# INLINE parse #-}

257

274

258-- | Run a 'Parser' with a 'Maybe' result type.

275-- | Run a 'Parser' with a 'Maybe' result type.

259parseMaybe :: (a -> Parser b) -> a -> Maybe b

276parseMaybe :: (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

261{-# INLINE parseMaybe #-}

278{-# INLINE parseMaybe #-}

262

279

263-- | Run a 'Parser' with an 'Either' result type.

280-- | Run a 'Parser' with an 'Either' result type.

264parseEither :: (a -> Parser b) -> a -> Either String b

281parseEither :: (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

266{-# INLINE parseEither #-}

283{-# INLINE parseEither #-}

267

284

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+

268-- | A key\/value pair for an 'Object'.

295-- | A key\/value pair for an 'Object'.

269type Pair = (Text, Value)

296type Pair = (Text, Value)

270

297

@@ -274,6 +301,24 @@ object :: [Pair] -> Value

274object = Object . H.fromList

301object = Object . H.fromList

275{-# INLINE object #-}

302{-# INLINE object #-}

276

303

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+

277-- | If the inner @Parser@ failed, modify the failure message using the

322-- | If the inner @Parser@ failed, modify the failure message using the

278-- provided function. This allows you to create more descriptive error messages.

323-- provided function. This allows you to create more descriptive error messages.

279-- For example:

324-- For example:

@@ -284,7 +329,7 @@ object = Object . H.fromList

284--

329--

285-- Since 0.6.2.0

330-- Since 0.6.2.0

286modifyFailure :: (String -> String) -> Parser a -> Parser a

331modifyFailure :: (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

288

333

289--------------------------------------------------------------------------------

334--------------------------------------------------------------------------------

290-- Generic and TH encoding configuration

335-- Generic and TH encoding configuration

tests/Properties.hs+8−8

@@ -49,28 +49,28 @@ toParseJSON :: (Arbitrary a, Eq a, Show a) =>

49 (Value -> Parser a) -> (a -> Value) -> a -> Property

50toParseJSON parsejson tojson x =

51 case parse parsejson . tojson $ x of

52− Error msg -> failure "parse" msg x

52+ Error path msg -> failure "parse" (formatError path msg) x

53− Success x' -> x === x'

53+ Success x' -> x === x'

55roundTrip :: (FromJSON a, ToJSON a, Show a) =>

56 (a -> a -> Property) -> a -> a -> Property

57roundTrip eq _ i =

58 case fmap fromJSON . L.parse value . encode . toJSON $ i of

59− L.Done _ (Success v) -> v `eq` i

59+ L.Done _ (Success v) -> v `eq` i

60− L.Done _ (Error err) -> failure "fromJSON" err i

60+ L.Done _ (Error path err) -> failure "fromJSON" (formatError path err) i

61− L.Fail _ _ err -> failure "parse" err i

61+ L.Fail _ _ err -> failure "parse" err i

63roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

64roundTripEq x y = roundTrip (===) x y

66toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property

67toFromJSON x = case fromJSON (toJSON x) of

68− Error err -> failure "fromJSON" err x

68+ Error path err -> failure "fromJSON" (formatError path err) x

69− Success x' -> x === x'

69+ Success x' -> x === x'

71modifyFailureProp :: String -> String -> Bool

72modifyFailureProp orig added =

73− result == Error (added ++ orig)

73+ result == Error [] (added ++ orig)

74 where

75 parser = const $ modifyFailure (added ++) $ fail orig

76 result :: Result ()

tests/Properties/ZonedTime.hs+2−2

@@ -43,8 +43,8 @@ zonedTimeToJSON = testGroup "ZonedTime" [

43 test format f = testProperty format go

44 where

45 go t = case fromJSON (toJSON' format t) of

46− Error msg -> failure "fromJSON" msg t

46+ Error path msg -> failure "fromJSON" (formatError path msg) t

47− Success t' -> t' === f t

47+ Success t' -> t' === f t

49clearTimeZone :: ZonedTime -> ZonedTime

50clearTimeZone t = t { zonedTimeZone = TimeZone 0 False "" }