e7657da · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge

e7657daBryan O'Sullivan11 years ago

Data/Aeson.hs+8−4

compare with master

unifiedsplit

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

142decodeStrict' = decodeStrictWith jsonEOF' fromJSON

143{-# INLINE decodeStrict' #-}

144

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

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

147+{-# INLINE eitherFormatError #-}

148+

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

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

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

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

147−eitherDecode = eitherDecodeWith jsonEOF fromJSON

151+eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF fromJSON

148{-# INLINE eitherDecode #-}

152{-# INLINE eitherDecode #-}

149

153

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

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

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

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

152−eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON

156+eitherDecodeStrict = eitherFormatError . eitherDecodeStrictWith jsonEOF fromJSON

153{-# INLINE eitherDecodeStrict #-}

157{-# INLINE eitherDecodeStrict #-}

154

158

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

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

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

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

157−eitherDecode' = eitherDecodeWith jsonEOF' fromJSON

161+eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' fromJSON

158{-# INLINE eitherDecode' #-}

162{-# INLINE eitherDecode' #-}

159

163

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

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

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

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

162−eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON

166+eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' fromJSON

163{-# INLINE eitherDecodeStrict' #-}

167{-# INLINE eitherDecodeStrict' #-}

164

168

165-- $use

169-- $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

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

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

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

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

76−import Data.Traversable (traverse)

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

77import Data.Vector (Vector)

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

79import Foreign.Storable (Storable)

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

102import System.Locale (defaultTimeLocale, dateTimeFmt)

103#endif

104

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

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

107+

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

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

106 toJSON (Identity a) = toJSON a

109 toJSON (Identity a) = toJSON a

107 {-# INLINE toJSON #-}

110 {-# INLINE toJSON #-}

@@ -421,7 +424,7 @@ instance (ToJSON a) => ToJSON [a] where

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

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

422

425

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

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

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

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

425 {-# INLINE parseJSON #-}

428 {-# INLINE parseJSON #-}

426

429

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

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

@@ -449,7 +452,7 @@ encodeVector xs

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

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

450

453

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

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

452− parseJSON = withArray "Vector a" $ V.mapM parseJSON

455+ parseJSON = withArray "Vector a" $ V.mapM (uncurry parseIndexedJSON) . V.indexed

453 {-# INLINE parseJSON #-}

456 {-# INLINE parseJSON #-}

454

457

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

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

@@ -457,7 +460,7 @@ vectorToJSON = Array . V.map toJSON . V.convert

457{-# INLINE vectorToJSON #-}

460{-# INLINE vectorToJSON #-}

458

461

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

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

460−vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON

463+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry parseIndexedJSON) . V.indexed

461{-# INLINE vectorParseJSON #-}

464{-# INLINE vectorParseJSON #-}

462

465

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

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

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

564

567

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

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

566 parseJSON = withObject "Map Text a" $

569 parseJSON = withObject "Map Text a" $

567− fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON

570+ fmap (H.foldrWithKey M.insert M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

568

571

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

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

570 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

573 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

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

589 toEncoding = encodeWithKey H.foldrWithKey

592 toEncoding = encodeWithKey H.foldrWithKey

590

593

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

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

592− parseJSON = withObject "HashMap Text a" $ traverse parseJSON

595+ parseJSON = withObject "HashMap Text a" $ H.traverseWithKey (\k v -> parseJSON v <?> Key k)

593

596

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

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

595 toJSON = Object . mapKeyVal LT.toStrict toJSON

598 toJSON = Object . mapKeyVal LT.toStrict toJSON

@@ -712,6 +715,9 @@ instance FromJSON UTCTime where

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

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

713 {-# INLINE parseJSON #-}

716 {-# INLINE parseJSON #-}

714

717

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

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

720+

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

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

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

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

717 mv <- VM.unsafeNew 2

723 mv <- VM.unsafeNew 2

@@ -728,8 +734,8 @@ instance (FromJSON a, FromJSON b) => FromJSON (a,b) where

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

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

729 let n = V.length ab

735 let n = V.length ab

730 in if n == 2

736 in if n == 2

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

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

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

738+ <*> parseJSONElemAtIndex 1 ab

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

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

734 show n ++ " into a pair"

740 show n ++ " into a pair"

735 {-# INLINE parseJSON #-}

741 {-# INLINE parseJSON #-}

@@ -752,9 +758,9 @@ instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where

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

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

753 let n = V.length abc

759 let n = V.length abc

754 in if n == 3

760 in if n == 3

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

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

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

762+ <*> parseJSONElemAtIndex 1 abc

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

763+ <*> parseJSONElemAtIndex 2 abc

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

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

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

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

760 {-# INLINE parseJSON #-}

766 {-# INLINE parseJSON #-}

@@ -780,10 +786,10 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>

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

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

781 let n = V.length abcd

787 let n = V.length abcd

782 in if n == 4

788 in if n == 4

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

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

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

790+ <*> parseJSONElemAtIndex 1 abcd

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

791+ <*> parseJSONElemAtIndex 2 abcd

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

792+ <*> parseJSONElemAtIndex 3 abcd

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

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

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

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

789 {-# INLINE parseJSON #-}

795 {-# INLINE parseJSON #-}

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

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

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

813 let n = V.length abcde

819 let n = V.length abcde

814 in if n == 5

820 in if n == 5

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

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

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

822+ <*> parseJSONElemAtIndex 1 abcde

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

823+ <*> parseJSONElemAtIndex 2 abcde

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

824+ <*> parseJSONElemAtIndex 3 abcde

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

825+ <*> parseJSONElemAtIndex 4 abcde

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

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

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

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

822 {-# INLINE parseJSON #-}

828 {-# INLINE parseJSON #-}

@@ -847,12 +853,12 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

848 let n = V.length abcdef

854 let n = V.length abcdef

849 in if n == 6

855 in if n == 6

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

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

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

857+ <*> parseJSONElemAtIndex 1 abcdef

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

858+ <*> parseJSONElemAtIndex 2 abcdef

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

859+ <*> parseJSONElemAtIndex 3 abcdef

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

860+ <*> parseJSONElemAtIndex 4 abcdef

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

861+ <*> parseJSONElemAtIndex 5 abcdef

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

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

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

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

858 {-# INLINE parseJSON #-}

864 {-# INLINE parseJSON #-}

@@ -885,13 +891,13 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

886 let n = V.length abcdefg

892 let n = V.length abcdefg

887 in if n == 7

893 in if n == 7

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

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

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

895+ <*> parseJSONElemAtIndex 1 abcdefg

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

896+ <*> parseJSONElemAtIndex 2 abcdefg

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

897+ <*> parseJSONElemAtIndex 3 abcdefg

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

898+ <*> parseJSONElemAtIndex 4 abcdefg

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

899+ <*> parseJSONElemAtIndex 5 abcdefg

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

900+ <*> parseJSONElemAtIndex 6 abcdefg

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

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

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

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

897 {-# INLINE parseJSON #-}

903 {-# INLINE parseJSON #-}

@@ -930,14 +936,14 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

932 else (,,,,,,,)

938 else (,,,,,,,)

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

939+ <$> parseJSONElemAtIndex 0 ary

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

940+ <*> parseJSONElemAtIndex 1 ary

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

941+ <*> parseJSONElemAtIndex 2 ary

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

942+ <*> parseJSONElemAtIndex 3 ary

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

943+ <*> parseJSONElemAtIndex 4 ary

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

944+ <*> parseJSONElemAtIndex 5 ary

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

945+ <*> parseJSONElemAtIndex 6 ary

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

946+ <*> parseJSONElemAtIndex 7 ary

941 {-# INLINE parseJSON #-}

947 {-# INLINE parseJSON #-}

942

948

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

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

@@ -976,15 +982,15 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

978 else (,,,,,,,,)

984 else (,,,,,,,,)

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

985+ <$> parseJSONElemAtIndex 0 ary

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

986+ <*> parseJSONElemAtIndex 1 ary

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

987+ <*> parseJSONElemAtIndex 2 ary

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

988+ <*> parseJSONElemAtIndex 3 ary

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

989+ <*> parseJSONElemAtIndex 4 ary

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

990+ <*> parseJSONElemAtIndex 5 ary

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

991+ <*> parseJSONElemAtIndex 6 ary

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

992+ <*> parseJSONElemAtIndex 7 ary

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

993+ <*> parseJSONElemAtIndex 8 ary

988 {-# INLINE parseJSON #-}

994 {-# INLINE parseJSON #-}

989

995

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

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

@@ -1026,16 +1032,16 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

1028 else (,,,,,,,,,)

1034 else (,,,,,,,,,)

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

1035+ <$> parseJSONElemAtIndex 0 ary

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

1036+ <*> parseJSONElemAtIndex 1 ary

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

1037+ <*> parseJSONElemAtIndex 2 ary

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

1038+ <*> parseJSONElemAtIndex 3 ary

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

1039+ <*> parseJSONElemAtIndex 4 ary

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

1040+ <*> parseJSONElemAtIndex 5 ary

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

1041+ <*> parseJSONElemAtIndex 6 ary

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

1042+ <*> parseJSONElemAtIndex 7 ary

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

1043+ <*> parseJSONElemAtIndex 8 ary

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

1044+ <*> parseJSONElemAtIndex 9 ary

1039 {-# INLINE parseJSON #-}

1045 {-# INLINE parseJSON #-}

1040

1046

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

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

@@ -1080,17 +1086,17 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

1082 else (,,,,,,,,,,)

1088 else (,,,,,,,,,,)

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

1089+ <$> parseJSONElemAtIndex 0 ary

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

1090+ <*> parseJSONElemAtIndex 1 ary

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

1091+ <*> parseJSONElemAtIndex 2 ary

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

1092+ <*> parseJSONElemAtIndex 3 ary

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

1093+ <*> parseJSONElemAtIndex 4 ary

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

1094+ <*> parseJSONElemAtIndex 5 ary

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

1095+ <*> parseJSONElemAtIndex 6 ary

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

1096+ <*> parseJSONElemAtIndex 7 ary

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

1097+ <*> parseJSONElemAtIndex 8 ary

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

1098+ <*> parseJSONElemAtIndex 9 ary

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

1099+ <*> parseJSONElemAtIndex 10 ary

1094 {-# INLINE parseJSON #-}

1100 {-# INLINE parseJSON #-}

1095

1101

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

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

@@ -1137,18 +1143,18 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

1139 else (,,,,,,,,,,,)

1145 else (,,,,,,,,,,,)

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

1146+ <$> parseJSONElemAtIndex 0 ary

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

1147+ <*> parseJSONElemAtIndex 1 ary

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

1148+ <*> parseJSONElemAtIndex 2 ary

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

1149+ <*> parseJSONElemAtIndex 3 ary

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

1150+ <*> parseJSONElemAtIndex 4 ary

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

1151+ <*> parseJSONElemAtIndex 5 ary

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

1152+ <*> parseJSONElemAtIndex 6 ary

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

1153+ <*> parseJSONElemAtIndex 7 ary

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

1154+ <*> parseJSONElemAtIndex 8 ary

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

1155+ <*> parseJSONElemAtIndex 9 ary

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

1156+ <*> parseJSONElemAtIndex 10 ary

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

1157+ <*> parseJSONElemAtIndex 11 ary

1152 {-# INLINE parseJSON #-}

1158 {-# INLINE parseJSON #-}

1153

1159

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

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

@@ -1198,19 +1204,19 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

1200 else (,,,,,,,,,,,,)

1206 else (,,,,,,,,,,,,)

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

1207+ <$> parseJSONElemAtIndex 0 ary

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

1208+ <*> parseJSONElemAtIndex 1 ary

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

1209+ <*> parseJSONElemAtIndex 2 ary

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

1210+ <*> parseJSONElemAtIndex 3 ary

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

1211+ <*> parseJSONElemAtIndex 4 ary

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

1212+ <*> parseJSONElemAtIndex 5 ary

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

1213+ <*> parseJSONElemAtIndex 6 ary

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

1214+ <*> parseJSONElemAtIndex 7 ary

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

1215+ <*> parseJSONElemAtIndex 8 ary

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

1216+ <*> parseJSONElemAtIndex 9 ary

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

1217+ <*> parseJSONElemAtIndex 10 ary

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

1218+ <*> parseJSONElemAtIndex 11 ary

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

1219+ <*> parseJSONElemAtIndex 12 ary

1214 {-# INLINE parseJSON #-}

1220 {-# INLINE parseJSON #-}

1215

1221

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

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

@@ -1262,20 +1268,20 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

1264 else (,,,,,,,,,,,,,)

1270 else (,,,,,,,,,,,,,)

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

1271+ <$> parseJSONElemAtIndex 0 ary

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

1272+ <*> parseJSONElemAtIndex 1 ary

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

1273+ <*> parseJSONElemAtIndex 2 ary

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

1274+ <*> parseJSONElemAtIndex 3 ary

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

1275+ <*> parseJSONElemAtIndex 4 ary

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

1276+ <*> parseJSONElemAtIndex 5 ary

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

1277+ <*> parseJSONElemAtIndex 6 ary

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

1278+ <*> parseJSONElemAtIndex 7 ary

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

1279+ <*> parseJSONElemAtIndex 8 ary

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

1280+ <*> parseJSONElemAtIndex 9 ary

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

1281+ <*> parseJSONElemAtIndex 10 ary

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

1282+ <*> parseJSONElemAtIndex 11 ary

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

1283+ <*> parseJSONElemAtIndex 12 ary

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

1284+ <*> parseJSONElemAtIndex 13 ary

1279 {-# INLINE parseJSON #-}

1285 {-# INLINE parseJSON #-}

1280

1286

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

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

@@ -1329,21 +1335,21 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

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

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

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

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

1331 else (,,,,,,,,,,,,,,)

1337 else (,,,,,,,,,,,,,,)

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

1338+ <$> parseJSONElemAtIndex 0 ary

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

1339+ <*> parseJSONElemAtIndex 1 ary

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

1340+ <*> parseJSONElemAtIndex 2 ary

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

1341+ <*> parseJSONElemAtIndex 3 ary

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

1342+ <*> parseJSONElemAtIndex 4 ary

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

1343+ <*> parseJSONElemAtIndex 5 ary

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

1344+ <*> parseJSONElemAtIndex 6 ary

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

1345+ <*> parseJSONElemAtIndex 7 ary

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

1346+ <*> parseJSONElemAtIndex 8 ary

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

1347+ <*> parseJSONElemAtIndex 9 ary

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

1348+ <*> parseJSONElemAtIndex 10 ary

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

1349+ <*> parseJSONElemAtIndex 11 ary

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

1350+ <*> parseJSONElemAtIndex 12 ary

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

1351+ <*> parseJSONElemAtIndex 13 ary

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

1352+ <*> parseJSONElemAtIndex 14 ary

1347 {-# INLINE parseJSON #-}

1353 {-# INLINE parseJSON #-}

1348

1354

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

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

@@ -1445,7 +1451,7 @@ fromJSON = parse parseJSON

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

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

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

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

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

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

1448− Just v -> parseJSON v

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

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

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

1450

1456

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

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

@@ -1458,7 +1464,7 @@ obj .: key = case H.lookup key obj of

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

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

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

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

1460 Nothing -> pure Nothing

1466 Nothing -> pure Nothing

1461− Just v -> parseJSON v

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

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

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

1463

1469

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

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