9cf5ae3 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Sort out the API backwards compatibility story

9cf5ae3Bryan O'Sullivan11 years ago

Data/Aeson.hs+9−4

compare with master

unifiedsplit

@@ -58,6 +58,7 @@ module Data.Aeson

58 , GFromJSON(..)

59 , GToJSON(..)

60 , genericToJSON

61+ , genericToEncoding

61 , genericParseJSON

62 , genericParseJSON

63 -- * Inspecting @'Value's@

64 -- * Inspecting @'Value's@

@@ -85,6 +86,8 @@ import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,

85 eitherDecodeWith, eitherDecodeStrictWith,

86 eitherDecodeWith, eitherDecodeStrictWith,

86 jsonEOF, json, jsonEOF', json')

87 jsonEOF, json, jsonEOF', json')

87import Data.Aeson.Types

88import Data.Aeson.Types

89+import Data.Aeson.Types.Internal (JSONPath, formatError)

90+import Data.Aeson.Types.Instances (ifromJSON)

88import qualified Data.ByteString as B

91import qualified Data.ByteString as B

89import qualified Data.ByteString.Lazy as L

92import qualified Data.ByteString.Lazy as L

@@ -149,22 +152,24 @@ eitherFormatError = either (Left . uncurry formatError) Right

149

152

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

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

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

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

152−eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF fromJSON

155+eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON

153{-# INLINE eitherDecode #-}

156{-# INLINE eitherDecode #-}

154

157

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

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

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

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

160+eitherDecodeStrict =

157−eitherDecodeStrict = eitherFormatError . eitherDecodeStrictWith jsonEOF fromJSON

161+ eitherFormatError . eitherDecodeStrictWith jsonEOF ifromJSON

158{-# INLINE eitherDecodeStrict #-}

162{-# INLINE eitherDecodeStrict #-}

159

163

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

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

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

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

162−eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' fromJSON

166+eitherDecode' = eitherFormatError . eitherDecodeWith jsonEOF' ifromJSON

163{-# INLINE eitherDecode' #-}

167{-# INLINE eitherDecode' #-}

164

168

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

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

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

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

171+eitherDecodeStrict' =

167−eitherDecodeStrict' = eitherFormatError . eitherDecodeStrictWith jsonEOF' fromJSON

172+ eitherFormatError . eitherDecodeStrictWith jsonEOF' ifromJSON

168{-# INLINE eitherDecodeStrict' #-}

173{-# INLINE eitherDecodeStrict' #-}

169

174

170-- $use

175-- $use

Data/Aeson/Internal.hsnew file+25

@@ -0,0 +1,25 @@

1+-- |

2+-- Module: Data.Aeson.Internal

4+-- License: Apache

5+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

6+-- Stability: experimental

7+-- Portability: portable

8+--

9+-- Internal types and functions.

10+--

11+-- __Note__: all declarations in this module are unstable, and prone

12+-- to being changed at any time.

13+

14+module Data.Aeson.Internal

15+ (

16+ IResult(..)

17+ , JSONPathElement

18+ , JSONPath

19+ , formatError

20+ , ifromJSON

21+ , iparse

22+ ) where

23+

24+import Data.Aeson.Types.Instances (ifromJSON)

25+import Data.Aeson.Types.Internal

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

@@ -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 (JSONPath, Result(..), Value(..))

33+import Data.Aeson.Types.Internal (IResult(..), 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 _ -> Nothing

293{-# INLINE decodeStrictWith #-}

294

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

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

296 -> Either (JSONPath, String) a

297eitherDecodeWith p to s =

298 case L.parse p s of

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

300− Success a -> Right a

300+ ISuccess a -> Right a

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

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

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

303{-# INLINE eitherDecodeWith #-}

304

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

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

306 -> Either (JSONPath, String) a

307eitherDecodeStrictWith p to s =

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

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

309− Success a -> Right a

309+ ISuccess a -> Right a

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

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

311{-# INLINE eitherDecodeStrictWith #-}

312

313-- $lazy

Data/Aeson/Types.hs+1−2

@@ -35,13 +35,12 @@ module Data.Aeson.Types

35 , ToJSON(..)

36 , KeyValue(..)

37 , modifyFailure

38− , JSONPath

39− , formatError

41 -- ** Generic JSON classes

39 -- ** Generic JSON classes

42 , GFromJSON(..)

40 , GFromJSON(..)

43 , GToJSON(..)

41 , GToJSON(..)

44 , genericToJSON

42 , genericToJSON

43+ , genericToEncoding

45 , genericParseJSON

44 , genericParseJSON

47 -- * Inspecting @'Value's@

46 -- * Inspecting @'Value's@

Data/Aeson/Types/Instances.hs+7

@@ -29,6 +29,7 @@ module Data.Aeson.Types.Instances

29 , GFromJSON(..)

30 , GToJSON(..)

31 , genericToJSON

32+ , genericToEncoding

32 , genericParseJSON

33 , genericParseJSON

34 -- * Types

35 -- * Types

@@ -44,6 +45,7 @@ module Data.Aeson.Types.Instances

45 -- * Functions

46 -- * Functions

46 , fromJSON

47 , fromJSON

48+ , ifromJSON

47 , (.:)

49 , (.:)

48 , (.:?)

50 , (.:?)

49 , (.!=)

51 , (.!=)

@@ -1457,6 +1459,11 @@ fromJSON :: (FromJSON a) => Value -> Result a

1457fromJSON = parse parseJSON

1459fromJSON = parse parseJSON

1458{-# INLINE fromJSON #-}

1460{-# INLINE fromJSON #-}

1459

1461

1462+-- | Convert a value from JSON, failing if the types do not match.

1463+ifromJSON :: (FromJSON a) => Value -> IResult a

1464+ifromJSON = iparse parseJSON

1465+{-# INLINE ifromJSON #-}

1466+

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

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

1461-- The result is 'empty' if the key is not present or the value cannot

1468-- The result is 'empty' if the key is not present or the value cannot

1462-- be converted to the desired type.

1469-- be converted to the desired type.

Data/Aeson/Types/Internal.hs+68−15

@@ -26,8 +26,10 @@ module Data.Aeson.Types.Internal

26 -- * Type conversion

27 , Parser

28 , Result(..)

29+ , IResult(..)

29 , JSONPathElement(..)

30 , JSONPathElement(..)

30 , JSONPath

31 , JSONPath

32+ , iparse

31 , parse

33 , parse

32 , parseEither

34 , parseEither

33 , parseMaybe

35 , parseMaybe

@@ -80,8 +82,13 @@ data JSONPathElement = Key Text

80 deriving (Eq, Show, Typeable)

82 deriving (Eq, Show, Typeable)

81type JSONPath = [JSONPathElement]

83type JSONPath = [JSONPathElement]

85+-- | The internal result of running a 'Parser'.

86+data IResult a = IError JSONPath String

87+ | ISuccess a

88+ deriving (Eq, Show, Typeable)

89+

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

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

84−data Result a = Error JSONPath String

91+data Result a = Error String

85 | Success a

92 | Success a

86 deriving (Eq, Show, Typeable)

93 deriving (Eq, Show, Typeable)

@@ -89,28 +96,57 @@ instance NFData JSONPathElement where

89 rnf (Key t) = rnf t

96 rnf (Key t) = rnf t

90 rnf (Index i) = rnf i

97 rnf (Index i) = rnf i

99+instance (NFData a) => NFData (IResult a) where

100+ rnf (ISuccess a) = rnf a

101+ rnf (IError path err) = rnf path `seq` rnf err

102+

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

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

93 rnf (Success a) = rnf a

104 rnf (Success a) = rnf a

94− rnf (Error path err) = rnf path `seq` rnf err

105+ rnf (Error err) = rnf err

106+

107+instance Functor IResult where

108+ fmap f (ISuccess a) = ISuccess (f a)

109+ fmap _ (IError path err) = IError path err

110+ {-# INLINE fmap #-}

111

96instance Functor Result where

112instance Functor Result where

97 fmap f (Success a) = Success (f a)

113 fmap f (Success a) = Success (f a)

98− fmap _ (Error path err) = Error path err

114+ fmap _ (Error err) = Error err

99 {-# INLINE fmap #-}

115 {-# INLINE fmap #-}

100

116

117+instance Monad IResult where

118+ return = ISuccess

119+ {-# INLINE return #-}

120+ ISuccess a >>= k = k a

121+ IError path err >>= _ = IError path err

122+ {-# INLINE (>>=) #-}

123+

101instance Monad Result where

124instance Monad Result where

102 return = Success

125 return = Success

103 {-# INLINE return #-}

126 {-# INLINE return #-}

104− Success a >>= k = k a

127+ Success a >>= k = k a

105− Error path err >>= _ = Error path err

128+ Error err >>= _ = Error err

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

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

107

130

131+instance Applicative IResult where

132+ pure = return

133+ {-# INLINE pure #-}

134+ (<*>) = ap

135+ {-# INLINE (<*>) #-}

136+

108instance Applicative Result where

137instance Applicative Result where

109 pure = return

138 pure = return

110 {-# INLINE pure #-}

139 {-# INLINE pure #-}

111 (<*>) = ap

140 (<*>) = ap

112 {-# INLINE (<*>) #-}

141 {-# INLINE (<*>) #-}

113

142

143+instance MonadPlus IResult where

144+ mzero = fail "mzero"

145+ {-# INLINE mzero #-}

146+ mplus a@(ISuccess _) _ = a

147+ mplus _ b = b

148+ {-# INLINE mplus #-}

149+

114instance MonadPlus Result where

150instance MonadPlus Result where

115 mzero = fail "mzero"

151 mzero = fail "mzero"

116 {-# INLINE mzero #-}

152 {-# INLINE mzero #-}

@@ -118,12 +154,24 @@ instance MonadPlus Result where

118 mplus _ b = b

154 mplus _ b = b

119 {-# INLINE mplus #-}

155 {-# INLINE mplus #-}

120

156

157+instance Alternative IResult where

158+ empty = mzero

159+ {-# INLINE empty #-}

160+ (<|>) = mplus

161+ {-# INLINE (<|>) #-}

162+

121instance Alternative Result where

163instance Alternative Result where

122 empty = mzero

164 empty = mzero

123 {-# INLINE empty #-}

165 {-# INLINE empty #-}

124 (<|>) = mplus

166 (<|>) = mplus

125 {-# INLINE (<|>) #-}

167 {-# INLINE (<|>) #-}

126

168

169+instance Monoid (IResult a) where

170+ mempty = fail "mempty"

171+ {-# INLINE mempty #-}

172+ mappend = mplus

173+ {-# INLINE mappend #-}

174+

127instance Monoid (Result a) where

175instance Monoid (Result a) where

128 mempty = fail "mempty"

176 mempty = fail "mempty"

129 {-# INLINE mempty #-}

177 {-# INLINE mempty #-}

@@ -288,9 +336,14 @@ emptyObject = Object H.empty

288

336

289-- | Run a 'Parser'.

337-- | Run a 'Parser'.

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

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

291−parse m v = runParser (m v) [] Error Success

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

292{-# INLINE parse #-}

340{-# INLINE parse #-}

293

341

342+-- | Run a 'Parser'.

343+iparse :: (a -> Parser b) -> a -> IResult b

344+iparse m v = runParser (m v) [] IError ISuccess

345+{-# INLINE iparse #-}

346+

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

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

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

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

296parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just

349parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just

@@ -298,18 +351,18 @@ parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just

298

351

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

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

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

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

354+parseEither m v = runParser (m v) [] onError Right

301−parseEither m v = runParser (m v) [] (\path msg -> Left $ formatError path msg) Right

355+ where onError path msg = Left (formatError path msg)

302{-# INLINE parseEither #-}

356{-# INLINE parseEither #-}

303

357

304−-- | Annotate error message with JSON Path error location

358+-- | Annotate an error message with a

359+-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.

305formatError :: JSONPath -> String -> String

360formatError :: JSONPath -> String -> String

306−formatError path msg = "Error in " ++ (formatJSONPath path) ++ ": " ++ msg

361+formatError path msg = "Error in " ++ (format "$" path) ++ ": " ++ msg

307− where formatJSONPath :: JSONPath -> String

362+ where

308− formatJSONPath p = format "$" p

363+ format pfx [] = pfx

309− where format :: String -> JSONPath -> String

310− format prefix [] = prefix

311− format prefix (Index idx:parts) = format (prefix ++ "[" ++ show idx ++ "]") parts

364+ format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts

312− format prefix (Key key:parts) = format (prefix ++ "." ++ unpack key) parts

365+ format pfx (Key key:parts) = format (pfx ++ "." ++ unpack key) parts

313

366

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

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

315type Pair = (Text, Value)

368type Pair = (Text, Value)

aeson.cabal+1

@@ -87,6 +87,7 @@ library

87 exposed-modules:

88 Data.Aeson

89 Data.Aeson.Encode

90+ Data.Aeson.Internal

90 Data.Aeson.Parser

91 Data.Aeson.Parser

91 Data.Aeson.Types

92 Data.Aeson.Types

92 Data.Aeson.TH

93 Data.Aeson.TH

tests/Properties.hs+12−11

@@ -3,6 +3,7 @@

3import Control.Monad (forM)

4import Data.Aeson (eitherDecode)

5import Data.Aeson.Encode

6+import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)

6import Data.Aeson.Parser (value)

7import Data.Aeson.Parser (value)

7import Data.Aeson.Types

8import Data.Aeson.Types

8import Data.ByteString.Builder (toLazyByteString)

9import Data.ByteString.Builder (toLazyByteString)

@@ -49,29 +50,29 @@ encodeInteger i = encode i === L.pack (show i)

49toParseJSON :: (Arbitrary a, Eq a, Show a) =>

50toParseJSON :: (Arbitrary a, Eq a, Show a) =>

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

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

51toParseJSON parsejson tojson x =

52toParseJSON parsejson tojson x =

52− case parse parsejson . tojson $ x of

53+ case iparse parsejson . tojson $ x of

53− Error path msg -> failure "parse" (formatError path msg) x

54+ IError path msg -> failure "parse" (formatError path msg) x

54− Success x' -> x === x'

55+ ISuccess x' -> x === x'

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

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

57 (a -> a -> Property) -> a -> a -> Property

58 (a -> a -> Property) -> a -> a -> Property

58roundTrip eq _ i =

59roundTrip eq _ i =

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

60+ case fmap ifromJSON . L.parse value . encode . toJSON $ i of

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

61+ L.Done _ (ISuccess v) -> v `eq` i

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

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

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

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

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

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

65roundTripEq x y = roundTrip (===) x y

66roundTripEq x y = roundTrip (===) x y

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

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

68−toFromJSON x = case fromJSON (toJSON x) of

69+toFromJSON x = case ifromJSON (toJSON x) of

69− Error path err -> failure "fromJSON" (formatError path err) x

70+ IError path err -> failure "fromJSON" (formatError path err) x

70− Success x' -> x === x'

71+ ISuccess x' -> x === x'

72modifyFailureProp :: String -> String -> Bool

73modifyFailureProp :: String -> String -> Bool

73modifyFailureProp orig added =

74modifyFailureProp orig added =

74− result == Error [] (added ++ orig)

75+ result == Error (added ++ orig)

75 where

76 where

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

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

77 result :: Result ()

78 result :: Result ()

tests/Properties/ZonedTime.hs+6−4

@@ -2,12 +2,13 @@

3module Properties.ZonedTime (zonedTimeToJSON) where

5+import Data.Aeson.Internal (IResult(..), formatError, ifromJSON)

5import Data.Aeson.Types

6import Data.Aeson.Types

6import Data.Time

7import Data.Time

7import Instances ()

8import Instances ()

8import Test.Framework (Test, testGroup)

9import Test.Framework (Test, testGroup)

9import Test.Framework.Providers.QuickCheck2 (testProperty)

10import Test.Framework.Providers.QuickCheck2 (testProperty)

10−import Test.QuickCheck ((===))

11+import Test.QuickCheck ((===), Property)

11import Types

12import Types

13#if !MIN_VERSION_time(1,5,0)

14#if !MIN_VERSION_time(1,5,0)

@@ -42,9 +43,10 @@ zonedTimeToJSON = testGroup "ZonedTime" [

42 test :: String -> (ZonedTime -> ZonedTime) -> Test

43 test :: String -> (ZonedTime -> ZonedTime) -> Test

43 test format f = testProperty format go

44 test format f = testProperty format go

44 where

45 where

46+ go :: ZonedTime -> Property

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

47+ go t = case ifromJSON (toJSON' format t) of

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

48+ IError path msg -> failure "fromJSON" (formatError path msg) t

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

49+ ISuccess t' -> t' === f t

49clearTimeZone :: ZonedTime -> ZonedTime

51clearTimeZone :: ZonedTime -> ZonedTime

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

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