8faba18 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Numeric types

8faba18Oleg Grenrus10 years ago

Data/Aeson/Encode/Builder.hs+4−4

compare with master

unifiedsplit

@@ -24,7 +24,7 @@ module Data.Aeson.Encode.Builder

24 , string

25 , unquoted

26 , quote

27− , number

27+ , scientific

28 , day

29 , localTime

30 , utcTime

@@ -59,7 +59,7 @@ import qualified Data.Vector as V

59encodeToBuilder :: Value -> Builder

60encodeToBuilder Null = null_

61encodeToBuilder (Bool b) = bool b

62−encodeToBuilder (Number n) = number n

62+encodeToBuilder (Number n) = scientific n

63encodeToBuilder (String s) = text s

64encodeToBuilder (Array v) = array v

65encodeToBuilder (Object m) = object m

@@ -128,8 +128,8 @@ c2w :: Char -> Word8

128c2w c = fromIntegral (ord c)

129

130-- | Encode a JSON number.

131−number :: Scientific -> Builder

131+scientific :: Scientific -> Builder

132−number s

132+scientific s

133 | e < 0 = scientificBuilder s

134 | otherwise = B.integerDec (coefficient s * 10 ^ e)

135 where

Data/Aeson/Encoding.hs+11

@@ -14,6 +14,17 @@ module Data.Aeson.Encoding

14 , text

15 , list

16 , dict

17+ , null_

18+ , bool

19+ -- ** Decimal numbers

20+ , int8, int16, int32, int64, int

21+ , word8, word16, word32, word64, word

22+ , integer, float, double, scientific

23+

24+ -- ** Decimal numbers as Text

25+ , int8Text, int16Text, int32Text, int64Text, intText

26+ , word8Text, word16Text, word32Text, word64Text, wordText

27+ , integerText, floatText, doubleText, scientificText

17 ) where

28 ) where

19import Data.Aeson.Encoding.Internal

30import Data.Aeson.Encoding.Internal

Data/Aeson/Encoding/Internal.hs+136−16

@@ -1,9 +1,11 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

1−{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable, RankNTypes #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE RankNTypes #-}

4+{-# LANGUAGE OverloadedStrings #-}

2module Data.Aeson.Encoding.Internal

5module Data.Aeson.Encoding.Internal

3 (

6 (

4 -- * Encoding

7 -- * Encoding

5 Encoding (..) -- TODO: export fromEncoding for now

8 Encoding (..) -- TODO: export fromEncoding for now

6− , fromEncoding

7 , unsafeToEncoding

9 , unsafeToEncoding

8 , Series (..) -- TODO: don't export constructor

10 , Series (..) -- TODO: don't export constructor

9 , pairs

11 , pairs

@@ -14,27 +16,40 @@ module Data.Aeson.Encoding.Internal

14 , emptyObject_

16 , emptyObject_

15 , wrapArray

17 , wrapArray

16 , wrapObject

18 , wrapObject

19+ , null_

20+ , bool

17 , text

21 , text

18 , list

22 , list

19 , dict

23 , dict

20 , tuple

24 , tuple

21 , (>*<)

25 , (>*<)

22− -- ** chars

26+ -- ** Decimal numbers

27+ , int8, int16, int32, int64, int

28+ , word8, word16, word32, word64, word

29+ , integer, float, double, scientific

30+ -- ** Decimal numbers as Text

31+ , int8Text, int16Text, int32Text, int64Text, intText

32+ , word8Text, word16Text, word32Text, word64Text, wordText

33+ , integerText, floatText, doubleText, scientificText

34+ -- ** JSON tokens

23 , comma, colon, openBracket, closeBracket, openCurly, closeCurly

35 , comma, colon, openBracket, closeBracket, openCurly, closeCurly

24 ) where

36 ) where

26−#if !MIN_VERSION_base(4,8,0)

38+import Prelude ()

27−import Data.Monoid (Monoid(..))

39+import Prelude.Compat

28−#endif

30−import Data.Text (Text)

31−import Data.ByteString.Builder (Builder, char7, toLazyByteString)

41+import Data.ByteString.Builder (Builder, char7, toLazyByteString)

32−import Data.Semigroup (Semigroup((<>)))

33import Data.ByteString.Builder.Prim (primBounded)

42import Data.ByteString.Builder.Prim (primBounded)

34−import Data.Typeable (Typeable)

43+import Data.Int

44+import Data.Scientific (Scientific)

45+import Data.Semigroup (Semigroup ((<>)))

46+import Data.Text (Text)

47+import Data.Typeable (Typeable)

48+import Data.Word

36−import qualified Data.ByteString.Lazy as BSL

37−import qualified Data.Aeson.Encode.Builder as B

50+import qualified Data.Aeson.Encode.Builder as EB

51+import qualified Data.ByteString.Builder as B

52+import qualified Data.ByteString.Lazy as BSL

39-- | An encoding of a JSON value.

54-- | An encoding of a JSON value.

40newtype Encoding = Encoding {

55newtype Encoding = Encoding {

@@ -90,10 +105,10 @@ nullEncoding :: Encoding -> Bool

90nullEncoding = BSL.null . toLazyByteString . fromEncoding

105nullEncoding = BSL.null . toLazyByteString . fromEncoding

106

92emptyArray_ :: Encoding

107emptyArray_ :: Encoding

93−emptyArray_ = Encoding B.emptyArray_

108+emptyArray_ = Encoding EB.emptyArray_

109

95emptyObject_ :: Encoding

110emptyObject_ :: Encoding

96−emptyObject_ = Encoding B.emptyObject_

111+emptyObject_ = Encoding EB.emptyObject_

112

98wrapArray :: Encoding -> Encoding

113wrapArray :: Encoding -> Encoding

99wrapArray e = openBracket <> e <> closeBracket

114wrapArray e = openBracket <> e <> closeBracket

@@ -101,6 +116,13 @@ wrapArray e = openBracket <> e <> closeBracket

101wrapObject :: Encoding -> Encoding

116wrapObject :: Encoding -> Encoding

102wrapObject e = openCurly <> e <> closeCurly

117wrapObject e = openCurly <> e <> closeCurly

103

118

119+null_ :: Encoding

120+null_ = Encoding EB.null_

121+

122+bool :: Bool -> Encoding

123+bool True = Encoding "true"

124+bool False = Encoding "false"

125+

104-- | Encode a series of key/value pairs, separated by commas.

126-- | Encode a series of key/value pairs, separated by commas.

105pairs :: Series -> Encoding

127pairs :: Series -> Encoding

106pairs = brackets '{' '}'

128pairs = brackets '{' '}'

@@ -109,7 +131,7 @@ pairs = brackets '{' '}'

109brackets :: Char -> Char -> Series -> Encoding

131brackets :: Char -> Char -> Series -> Encoding

110brackets begin end (Value v) = Encoding $

132brackets begin end (Value v) = Encoding $

111 char7 begin <> fromEncoding v <> char7 end

133 char7 begin <> fromEncoding v <> char7 end

112−brackets begin end Empty = Encoding (primBounded (B.ascii2 (begin,end)) ())

134+brackets begin end Empty = Encoding (primBounded (EB.ascii2 (begin,end)) ())

113

135

114list :: (a -> Encoding) -> [a] -> Encoding

136list :: (a -> Encoding) -> [a] -> Encoding

115list _ [] = emptyArray_

137list _ [] = emptyArray_

@@ -150,7 +172,7 @@ tuple b = Encoding (char7 '[' <> fromEncoding b <> char7 ']')

150{-# INLINE tuple #-}

172{-# INLINE tuple #-}

151

173

152text :: Text -> Encoding

174text :: Text -> Encoding

153−text = Encoding . B.text

175+text = Encoding . EB.text

154

176

155-------------------------------------------------------------------------------

177-------------------------------------------------------------------------------

156-- chars

178-- chars

@@ -164,3 +186,101 @@ closeBracket = Encoding $ char7 ']'

164openCurly = Encoding $ char7 '{'

186openCurly = Encoding $ char7 '{'

165closeCurly = Encoding $ char7 '}'

187closeCurly = Encoding $ char7 '}'

166

188

189+-------------------------------------------------------------------------------

190+-- Decimal numbers

191+-------------------------------------------------------------------------------

192+

193+int8 :: Int8 -> Encoding

194+int8 = Encoding . B.int8Dec

195+

196+int16 :: Int16 -> Encoding

197+int16 = Encoding . B.int16Dec

198+

199+int32 :: Int32 -> Encoding

200+int32 = Encoding . B.int32Dec

201+

202+int64 :: Int64 -> Encoding

203+int64 = Encoding . B.int64Dec

204+

205+int :: Int -> Encoding

206+int = Encoding . B.intDec

207+

208+word8 :: Word8 -> Encoding

209+word8 = Encoding . B.word8Dec

210+

211+word16 :: Word16 -> Encoding

212+word16 = Encoding . B.word16Dec

213+

214+word32 :: Word32 -> Encoding

215+word32 = Encoding . B.word32Dec

216+

217+word64 :: Word64 -> Encoding

218+word64 = Encoding . B.word64Dec

219+

220+word :: Word -> Encoding

221+word = Encoding . B.wordDec

222+

223+integer :: Integer -> Encoding

224+integer = Encoding . B.integerDec

225+

226+float :: Float -> Encoding

227+float = realFloatToEncoding $ Encoding . B.floatDec

228+

229+double :: Double -> Encoding

230+double = realFloatToEncoding $ Encoding . B.doubleDec

231+

232+scientific :: Scientific -> Encoding

233+scientific = Encoding . EB.scientific

234+

235+realFloatToEncoding :: RealFloat a => (a -> Encoding) -> a -> Encoding

236+realFloatToEncoding e d

237+ | isNaN d || isInfinite d = null_

238+ | otherwise = e d

239+{-# INLINE realFloatToEncoding #-}

240+

241+-------------------------------------------------------------------------------

242+-- Decimal numbers as Text

243+-------------------------------------------------------------------------------

244+

245+int8Text :: Int8 -> Encoding

246+int8Text = Encoding . EB.quote . B.int8Dec

247+

248+int16Text :: Int16 -> Encoding

249+int16Text = Encoding . EB.quote . B.int16Dec

250+

251+int32Text :: Int32 -> Encoding

252+int32Text = Encoding . EB.quote . B.int32Dec

253+

254+int64Text :: Int64 -> Encoding

255+int64Text = Encoding . EB.quote . B.int64Dec

256+

257+intText :: Int -> Encoding

258+intText = Encoding . EB.quote . B.intDec

259+

260+word8Text :: Word8 -> Encoding

261+word8Text = Encoding . EB.quote . B.word8Dec

262+

263+word16Text :: Word16 -> Encoding

264+word16Text = Encoding . EB.quote . B.word16Dec

265+

266+word32Text :: Word32 -> Encoding

267+word32Text = Encoding . EB.quote . B.word32Dec

268+

269+word64Text :: Word64 -> Encoding

270+word64Text = Encoding . EB.quote . B.word64Dec

271+

272+wordText :: Word -> Encoding

273+wordText = Encoding . EB.quote . B.wordDec

274+

275+integerText :: Integer -> Encoding

276+integerText = Encoding . EB.quote . B.integerDec

277+

278+-- | TODO: check infinite and nan?

279+floatText :: Float -> Encoding

280+floatText = Encoding . EB.quote . B.floatDec

281+

282+doubleText :: Double -> Encoding

283+doubleText = Encoding . EB.quote . B.doubleDec

284+

285+scientificText :: Scientific -> Encoding

286+scientificText = Encoding . EB.quote . EB.scientific

Data/Aeson/Types/FromJSON.hs+76−21

@@ -73,7 +73,9 @@ import Data.Aeson.Functions (mapKey)

73import Data.Aeson.Types.Generic

74import Data.Aeson.Types.Internal

76−import qualified Data.Aeson.Parser.Time as Time

76+import qualified Data.Aeson.Parser.Time as Time

77+import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly,

78+ scientific)

78import Control.Applicative (Const (..), (<|>))

80import Control.Applicative (Const (..), (<|>))

79import Control.Monad ((<=<))

81import Control.Monad ((<=<))

@@ -114,8 +116,8 @@ import qualified Data.Scientific as Scientific

114import qualified Data.Sequence as Seq

116import qualified Data.Sequence as Seq

115import qualified Data.Set as Set

117import qualified Data.Set as Set

116import qualified Data.Text as T

118import qualified Data.Text as T

119+import qualified Data.Text.Encoding as T

117import qualified Data.Text.Lazy as LT

120import qualified Data.Text.Lazy as LT

118−import qualified Data.Text.Read as TR

119import qualified Data.Tree as Tree

121import qualified Data.Tree as Tree

120import qualified Data.Vector as V

122import qualified Data.Vector as V

121import qualified Data.Vector.Generic as VG

123import qualified Data.Vector.Generic as VG

@@ -177,6 +179,15 @@ parseIntegral :: Integral a => String -> Value -> Parser a

177parseIntegral expected = withScientific expected $ pure . truncate

179parseIntegral expected = withScientific expected $ pure . truncate

178{-# INLINE parseIntegral #-}

180{-# INLINE parseIntegral #-}

179

181

182+parseScientificText :: Text -> Parser Scientific

183+parseScientificText

184+ = either fail pure

185+ . A.parseOnly (A.scientific <* A.endOfInput)

186+ . T.encodeUtf8

187+

188+parseIntegralText :: Integral a => Text -> Parser a

189+parseIntegralText t = truncate <$> parseScientificText t

190+

180parseOptionalFieldWith :: (Value -> Parser (Maybe a))

191parseOptionalFieldWith :: (Value -> Parser (Maybe a))

181 -> Object -> Text -> Parser (Maybe a)

192 -> Object -> Text -> Parser (Maybe a)

182parseOptionalFieldWith pj obj key =

193parseOptionalFieldWith pj obj key =

@@ -1000,6 +1011,12 @@ instance FromJSON Bool where

1000 parseJSON = withBool "Bool" pure

1011 parseJSON = withBool "Bool" pure

1001 {-# INLINE parseJSON #-}

1012 {-# INLINE parseJSON #-}

1002

1013

1014+instance FromJSONKey Bool where

1015+ fromJSONKey = FromJSONKeyTextParser $ \t -> case t of

1016+ "true" -> pure True

1017+ "false" -> pure False

1018+ _ -> fail $ "Cannot parse key into Bool: " ++ T.unpack t

1019+

1003instance FromJSON Ordering where

1020instance FromJSON Ordering where

1004 parseJSON = withText "Ordering" $ \s ->

1021 parseJSON = withText "Ordering" $ \s ->

1005 case s of

1022 case s of

@@ -1029,6 +1046,13 @@ instance FromJSON Double where

1029 parseJSON = parseRealFloat "Double"

1046 parseJSON = parseRealFloat "Double"

1030 {-# INLINE parseJSON #-}

1047 {-# INLINE parseJSON #-}

1031

1048

1049+instance FromJSONKey Double where

1050+ fromJSONKey = FromJSONKeyTextParser $ \t -> case t of

1051+ "NaN" -> pure (0/0)

1052+ "Infinity" -> pure (1/0)

1053+ "-Infinity" -> pure (negate 1/0)

1054+ _ -> Scientific.toRealFloat <$> parseScientificText t

1055+

1032instance FromJSON Number where

1056instance FromJSON Number where

1033 parseJSON (Number s) = pure $ scientificToNumber s

1057 parseJSON (Number s) = pure $ scientificToNumber s

1034 parseJSON Null = pure (D (0/0))

1058 parseJSON Null = pure (D (0/0))

@@ -1039,7 +1063,14 @@ instance FromJSON Float where

1039 parseJSON = parseRealFloat "Float"

1063 parseJSON = parseRealFloat "Float"

1040 {-# INLINE parseJSON #-}

1064 {-# INLINE parseJSON #-}

1041

1065

1066+instance FromJSONKey Float where

1067+ fromJSONKey = FromJSONKeyTextParser $ \t -> case t of

1068+ "NaN" -> pure (0/0)

1069+ "Infinity" -> pure (1/0)

1070+ "-Infinity" -> pure (negate 1/0)

1071+ _ -> Scientific.toRealFloat <$> parseScientificText t

1072+

1042−instance FromJSON (Ratio Integer) where

1073+instance (FromJSON a, Integral a) => FromJSON (Ratio a) where

1043 parseJSON = withObject "Rational" $ \obj ->

1074 parseJSON = withObject "Rational" $ \obj ->

1044 (%) <$> obj .: "numerator"

1075 (%) <$> obj .: "numerator"

1045 <*> obj .: "denominator"

1076 <*> obj .: "denominator"

@@ -1057,6 +1088,9 @@ instance FromJSON Int where

1057 parseJSON = parseIntegral "Int"

1088 parseJSON = parseIntegral "Int"

1058 {-# INLINE parseJSON #-}

1089 {-# INLINE parseJSON #-}

1059

1090

1091+instance FromJSONKey Int where

1092+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1093+

1060-- | /WARNING:/ Only parse Integers from trusted input since an

1094-- | /WARNING:/ Only parse Integers from trusted input since an

1061-- attacker could easily fill up the memory of the target system by

1095-- attacker could easily fill up the memory of the target system by

1062-- specifying a scientific number with a big exponent like

1096-- specifying a scientific number with a big exponent like

@@ -1065,52 +1099,91 @@ instance FromJSON Integer where

1065 parseJSON = withScientific "Integral" $ pure . truncate

1099 parseJSON = withScientific "Integral" $ pure . truncate

1066 {-# INLINE parseJSON #-}

1100 {-# INLINE parseJSON #-}

1067

1101

1102+instance FromJSONKey Integer where

1103+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1104+

1068instance FromJSON Natural where

1105instance FromJSON Natural where

1069 parseJSON = withScientific "Natural" $ \s ->

1106 parseJSON = withScientific "Natural" $ \s ->

1070 if Scientific.coefficient s < 0

1107 if Scientific.coefficient s < 0

1071 then fail $ "Expected a Natural number but got the negative number: " <> show s

1108 then fail $ "Expected a Natural number but got the negative number: " <> show s

1072 else pure $ truncate s

1109 else pure $ truncate s

1073

1110

1111+instance FromJSONKey Natural where

1112+ fromJSONKey = FromJSONKeyTextParser $ \t -> parseScientificText t >>= \s ->

1113+ if Scientific.coefficient s < 0

1114+ then fail $ "Expected a Natural number but got the negative number: " <> show s

1115+ else pure $ truncate s

1116+

1074instance FromJSON Int8 where

1117instance FromJSON Int8 where

1075 parseJSON = parseIntegral "Int8"

1118 parseJSON = parseIntegral "Int8"

1076 {-# INLINE parseJSON #-}

1119 {-# INLINE parseJSON #-}

1077

1120

1121+instance FromJSONKey Int8 where

1122+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1123+

1078instance FromJSON Int16 where

1124instance FromJSON Int16 where

1079 parseJSON = parseIntegral "Int16"

1125 parseJSON = parseIntegral "Int16"

1080 {-# INLINE parseJSON #-}

1126 {-# INLINE parseJSON #-}

1081

1127

1128+instance FromJSONKey Int16 where

1129+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1130+

1082instance FromJSON Int32 where

1131instance FromJSON Int32 where

1083 parseJSON = parseIntegral "Int32"

1132 parseJSON = parseIntegral "Int32"

1084 {-# INLINE parseJSON #-}

1133 {-# INLINE parseJSON #-}

1085

1134

1135+instance FromJSONKey Int32 where

1136+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1137+

1086instance FromJSON Int64 where

1138instance FromJSON Int64 where

1087 parseJSON = parseIntegral "Int64"

1139 parseJSON = parseIntegral "Int64"

1088 {-# INLINE parseJSON #-}

1140 {-# INLINE parseJSON #-}

1089

1141

1142+instance FromJSONKey Int64 where

1143+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1144+

1090instance FromJSON Word where

1145instance FromJSON Word where

1091 parseJSON = parseIntegral "Word"

1146 parseJSON = parseIntegral "Word"

1092 {-# INLINE parseJSON #-}

1147 {-# INLINE parseJSON #-}

1093

1148

1149+instance FromJSONKey Word where

1150+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1151+

1094instance FromJSON Word8 where

1152instance FromJSON Word8 where

1095 parseJSON = parseIntegral "Word8"

1153 parseJSON = parseIntegral "Word8"

1096 {-# INLINE parseJSON #-}

1154 {-# INLINE parseJSON #-}

1097

1155

1156+instance FromJSONKey Word8 where

1157+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1158+

1098instance FromJSON Word16 where

1159instance FromJSON Word16 where

1099 parseJSON = parseIntegral "Word16"

1160 parseJSON = parseIntegral "Word16"

1100 {-# INLINE parseJSON #-}

1161 {-# INLINE parseJSON #-}

1101

1162

1163+instance FromJSONKey Word16 where

1164+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1165+

1102instance FromJSON Word32 where

1166instance FromJSON Word32 where

1103 parseJSON = parseIntegral "Word32"

1167 parseJSON = parseIntegral "Word32"

1104 {-# INLINE parseJSON #-}

1168 {-# INLINE parseJSON #-}

1105

1169

1170+instance FromJSONKey Word32 where

1171+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1172+

1106instance FromJSON Word64 where

1173instance FromJSON Word64 where

1107 parseJSON = parseIntegral "Word64"

1174 parseJSON = parseIntegral "Word64"

1108 {-# INLINE parseJSON #-}

1175 {-# INLINE parseJSON #-}

1109

1176

1177+instance FromJSONKey Word64 where

1178+ fromJSONKey = FromJSONKeyTextParser parseIntegralText

1179+

1110instance FromJSON Text where

1180instance FromJSON Text where

1111 parseJSON = withText "Text" pure

1181 parseJSON = withText "Text" pure

1112 {-# INLINE parseJSON #-}

1182 {-# INLINE parseJSON #-}

1113

1183

1184+instance FromJSONKey Text where

1185+ fromJSONKey = fromJSONKeyCoerce

1186+

1114instance FromJSON LT.Text where

1187instance FromJSON LT.Text where

1115 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict

1188 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict

1116 {-# INLINE parseJSON #-}

1189 {-# INLINE parseJSON #-}

@@ -1385,24 +1458,6 @@ instance FromJSONKey b => FromJSONKey (Tagged a b) where

1385-- Instances for converting from map keys

1458-- Instances for converting from map keys

1386-------------------------------------------------------------------------------

1459-------------------------------------------------------------------------------

1387

1460

1388−instance FromJSONKey Text where

1389− fromJSONKey = fromJSONKeyCoerce

1390−

1391−instance FromJSONKey Bool where

1392− fromJSONKey = FromJSONKeyTextParser $ \t -> case t of

1393− "true" -> pure True

1394− "false" -> pure False

1395− _ -> fail $ "Cannot parse key into Bool: " ++ T.unpack t

1396−

1397−instance FromJSONKey Int where

1398− -- not sure if there if there is already a helper in

1399− -- aeson for doing this.

1400− fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.signed TR.decimal t of

1401− Left err -> fail err

1402− Right (v,t2) -> if T.null t2

1403− then return v

1404− else fail "Was not an integer, had extra stuff."

1405−

1406instance (FromJSON a, FromJSON b) => FromJSONKey (a,b)

1461instance (FromJSON a, FromJSON b) => FromJSONKey (a,b)

1407instance (FromJSON a, FromJSON b, FromJSON c) => FromJSONKey (a,b,c)

1462instance (FromJSON a, FromJSON b, FromJSON c) => FromJSONKey (a,b,c)

1408instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSONKey (a,b,c,d)

1463instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSONKey (a,b,c,d)

Data/Aeson/Types/ToJSON.hs+106−46

@@ -107,8 +107,6 @@ import qualified Data.Set as Set

107import qualified Data.Text as T

108import qualified Data.Text.Encoding as T

109import qualified Data.Text.Lazy as LT

110−import qualified Data.Text.Lazy.Builder as LTB

111−import qualified Data.Text.Lazy.Builder.Int as LTBI

112import qualified Data.Tree as Tree

110import qualified Data.Tree as Tree

113import qualified Data.Vector as V

111import qualified Data.Vector as V

114import qualified Data.Vector.Generic as VG

112import qualified Data.Vector.Generic as VG

@@ -134,12 +132,6 @@ realFloatToJSON d

134 | otherwise = Number $ Scientific.fromFloatDigits d

132 | otherwise = Number $ Scientific.fromFloatDigits d

135{-# INLINE realFloatToJSON #-}

133{-# INLINE realFloatToJSON #-}

136

134

137−realFloatToEncoding :: RealFloat a => a -> Encoding

138−realFloatToEncoding d

139− | isNaN d || isInfinite d = Encoding EB.null_

140− | otherwise = toEncoding (Scientific.fromFloatDigits d)

141−{-# INLINE realFloatToEncoding #-}

142−

143-------------------------------------------------------------------------------

135-------------------------------------------------------------------------------

144-- Generics

136-- Generics

145-------------------------------------------------------------------------------

137-------------------------------------------------------------------------------

@@ -1139,9 +1131,15 @@ instance ToJSON Bool where

1139 toJSON = Bool

1131 toJSON = Bool

1140 {-# INLINE toJSON #-}

1132 {-# INLINE toJSON #-}

1141

1133

1142− toEncoding = Encoding . EB.bool

1134+ toEncoding = E.bool

1143 {-# INLINE toEncoding #-}

1135 {-# INLINE toEncoding #-}

1144

1136

1137+instance ToJSONKey Bool where

1138+ toJSONKey = ToJSONKeyText

1139+ ( (\x -> if x then "true" else "false")

1140+ , (\x -> toEncoding $ if x then ("true" :: Text) else "false")

1141+ )

1142+

1145

1143

1146instance ToJSON Ordering where

1144instance ToJSON Ordering where

1147 toJSON = toJSON . orderingToText

1145 toJSON = toJSON . orderingToText

@@ -1179,9 +1177,13 @@ instance ToJSON Double where

1179 toJSON = realFloatToJSON

1177 toJSON = realFloatToJSON

1180 {-# INLINE toJSON #-}

1178 {-# INLINE toJSON #-}

1181

1179

1182− toEncoding = realFloatToEncoding

1180+ toEncoding = E.double

1183 {-# INLINE toEncoding #-}

1181 {-# INLINE toEncoding #-}

1184

1182

1183+instance ToJSONKey Double where

1184+ toJSONKey = toJSONKeyTextEnc E.doubleText

1185+ {-# INLINE toJSONKey #-}

1186+

1185

1187

1186instance ToJSON Number where

1188instance ToJSON Number where

1187 toJSON (D d) = toJSON d

1189 toJSON (D d) = toJSON d

@@ -1197,20 +1199,23 @@ instance ToJSON Float where

1197 toJSON = realFloatToJSON

1199 toJSON = realFloatToJSON

1198 {-# INLINE toJSON #-}

1200 {-# INLINE toJSON #-}

1199

1201

1200− toEncoding = realFloatToEncoding

1202+ toEncoding = E.float

1201 {-# INLINE toEncoding #-}

1203 {-# INLINE toEncoding #-}

1202

1204

1205+instance ToJSONKey Float where

1206+ toJSONKey = toJSONKeyTextEnc E.floatText

1207+ {-# INLINE toJSONKey #-}

1208+

1203

1209

1204−instance ToJSON (Ratio Integer) where

1210+instance (ToJSON a, Integral a) => ToJSON (Ratio a) where

1205 toJSON r = object [ "numerator" .= numerator r

1211 toJSON r = object [ "numerator" .= numerator r

1206 , "denominator" .= denominator r

1212 , "denominator" .= denominator r

1207 ]

1213 ]

1208 {-# INLINE toJSON #-}

1214 {-# INLINE toJSON #-}

1209

1215

1210− toEncoding r = Encoding $

1216+ toEncoding r = E.pairs $

1211− B.shortByteString "{\"numerator\":" <> builder (numerator r) <>

1217+ "numerator" .= numerator r <>

1212− B.shortByteString ",\"denominator\":" <> builder (denominator r) <>

1218+ "denominator" .= denominator r

1213− B.char7 '}'

1214 {-# INLINE toEncoding #-}

1219 {-# INLINE toEncoding #-}

1215

1220

1216

1221

@@ -1218,24 +1223,37 @@ instance HasResolution a => ToJSON (Fixed a) where

1218 toJSON = Number . realToFrac

1223 toJSON = Number . realToFrac

1219 {-# INLINE toJSON #-}

1224 {-# INLINE toJSON #-}

1220

1225

1221− toEncoding = Encoding . EB.number . realToFrac

1226+ toEncoding = E.scientific . realToFrac

1222 {-# INLINE toEncoding #-}

1227 {-# INLINE toEncoding #-}

1223

1228

1229+instance HasResolution a => ToJSONKey (Fixed a) where

1230+ toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)

1231+ {-# INLINE toJSONKey #-}

1232+

1224

1233

1225instance ToJSON Int where

1234instance ToJSON Int where

1226 toJSON = Number . fromIntegral

1235 toJSON = Number . fromIntegral

1227 {-# INLINE toJSON #-}

1236 {-# INLINE toJSON #-}

1228

1237

1229− toEncoding = Encoding . B.intDec

1238+ toEncoding = E.int

1230 {-# INLINE toEncoding #-}

1239 {-# INLINE toEncoding #-}

1231

1240

1241+instance ToJSONKey Int where

1242+ toJSONKey = toJSONKeyTextEnc E.intText

1243+ {-# INLINE toJSONKey #-}

1244+

1245+

1232instance ToJSON Integer where

1246instance ToJSON Integer where

1233 toJSON = Number . fromInteger

1247 toJSON = Number . fromInteger

1234 {-# INLINE toJSON #-}

1248 {-# INLINE toJSON #-}

1235

1249

1236− toEncoding = Encoding . B.integerDec

1250+ toEncoding = E.integer

1237 {-# INLINE toEncoding #-}

1251 {-# INLINE toEncoding #-}

1238

1252

1253+instance ToJSONKey Integer where

1254+ toJSONKey = toJSONKeyTextEnc E.integerText

1255+ {-# INLINE toJSONKey #-}

1256+

1239

1257

1240instance ToJSON Natural where

1258instance ToJSON Natural where

1241 toJSON = toJSON . toInteger

1259 toJSON = toJSON . toInteger

@@ -1244,84 +1262,130 @@ instance ToJSON Natural where

1244 toEncoding = toEncoding . toInteger

1262 toEncoding = toEncoding . toInteger

1245 {-# INLINE toEncoding #-}

1263 {-# INLINE toEncoding #-}

1246

1264

1265+instance ToJSONKey Natural where

1266+ toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)

1267+ {-# INLINE toJSONKey #-}

1268+

1247

1269

1248instance ToJSON Int8 where

1270instance ToJSON Int8 where

1249 toJSON = Number . fromIntegral

1271 toJSON = Number . fromIntegral

1250 {-# INLINE toJSON #-}

1272 {-# INLINE toJSON #-}

1251

1273

1252− toEncoding = Encoding . B.int8Dec

1274+ toEncoding = E.int8

1253 {-# INLINE toEncoding #-}

1275 {-# INLINE toEncoding #-}

1254

1276

1277+instance ToJSONKey Int8 where

1278+ toJSONKey = toJSONKeyTextEnc E.int8Text

1279+ {-# INLINE toJSONKey #-}

1280+

1255

1281

1256instance ToJSON Int16 where

1282instance ToJSON Int16 where

1257 toJSON = Number . fromIntegral

1283 toJSON = Number . fromIntegral

1258 {-# INLINE toJSON #-}

1284 {-# INLINE toJSON #-}

1259

1285

1260− toEncoding = Encoding . B.int16Dec

1286+ toEncoding = E.int16

1261 {-# INLINE toEncoding #-}

1287 {-# INLINE toEncoding #-}

1262

1288

1289+instance ToJSONKey Int16 where

1290+ toJSONKey = toJSONKeyTextEnc E.int16Text

1291+ {-# INLINE toJSONKey #-}

1292+

1263

1293

1264instance ToJSON Int32 where

1294instance ToJSON Int32 where

1265 toJSON = Number . fromIntegral

1295 toJSON = Number . fromIntegral

1266 {-# INLINE toJSON #-}

1296 {-# INLINE toJSON #-}

1267

1297

1268− toEncoding = Encoding . B.int32Dec

1298+ toEncoding = E.int32

1269 {-# INLINE toEncoding #-}

1299 {-# INLINE toEncoding #-}

1270

1300

1301+instance ToJSONKey Int32 where

1302+ toJSONKey = toJSONKeyTextEnc E.int32Text

1303+ {-# INLINE toJSONKey #-}

1304+

1271

1305

1272instance ToJSON Int64 where

1306instance ToJSON Int64 where

1273 toJSON = Number . fromIntegral

1307 toJSON = Number . fromIntegral

1274 {-# INLINE toJSON #-}

1308 {-# INLINE toJSON #-}

1275

1309

1276− toEncoding = Encoding . B.int64Dec

1310+ toEncoding = E.int64

1277 {-# INLINE toEncoding #-}

1311 {-# INLINE toEncoding #-}

1278

1312

1313+instance ToJSONKey Int64 where

1314+ toJSONKey = toJSONKeyTextEnc E.int64Text

1315+ {-# INLINE toJSONKey #-}

1316+

1279

1317

1280instance ToJSON Word where

1318instance ToJSON Word where

1281 toJSON = Number . fromIntegral

1319 toJSON = Number . fromIntegral

1282 {-# INLINE toJSON #-}

1320 {-# INLINE toJSON #-}

1283

1321

1284− toEncoding = Encoding . B.wordDec

1322+ toEncoding = E.word

1285 {-# INLINE toEncoding #-}

1323 {-# INLINE toEncoding #-}

1286

1324

1325+instance ToJSONKey Word where

1326+ toJSONKey = toJSONKeyTextEnc E.wordText

1327+ {-# INLINE toJSONKey #-}

1328+

1287

1329

1288instance ToJSON Word8 where

1330instance ToJSON Word8 where

1289 toJSON = Number . fromIntegral

1331 toJSON = Number . fromIntegral

1290 {-# INLINE toJSON #-}

1332 {-# INLINE toJSON #-}

1291

1333

1292− toEncoding = Encoding . B.word8Dec

1334+ toEncoding = E.word8

1293 {-# INLINE toEncoding #-}

1335 {-# INLINE toEncoding #-}

1294

1336

1337+instance ToJSONKey Word8 where

1338+ toJSONKey = toJSONKeyTextEnc E.word8Text

1339+ {-# INLINE toJSONKey #-}

1340+

1295

1341

1296instance ToJSON Word16 where

1342instance ToJSON Word16 where

1297 toJSON = Number . fromIntegral

1343 toJSON = Number . fromIntegral

1298 {-# INLINE toJSON #-}

1344 {-# INLINE toJSON #-}

1299

1345

1300− toEncoding = Encoding . B.word16Dec

1346+ toEncoding = E.word16

1301 {-# INLINE toEncoding #-}

1347 {-# INLINE toEncoding #-}

1302

1348

1349+instance ToJSONKey Word16 where

1350+ toJSONKey = toJSONKeyTextEnc E.word16Text

1351+ {-# INLINE toJSONKey #-}

1352+

1303

1353

1304instance ToJSON Word32 where

1354instance ToJSON Word32 where

1305 toJSON = Number . fromIntegral

1355 toJSON = Number . fromIntegral

1306 {-# INLINE toJSON #-}

1356 {-# INLINE toJSON #-}

1307

1357

1308− toEncoding = Encoding . B.word32Dec

1358+ toEncoding = E.word32

1309 {-# INLINE toEncoding #-}

1359 {-# INLINE toEncoding #-}

1310

1360

1361+instance ToJSONKey Word32 where

1362+ toJSONKey = toJSONKeyTextEnc E.word32Text

1363+ {-# INLINE toJSONKey #-}

1364+

1365+

1311instance ToJSON Word64 where

1366instance ToJSON Word64 where

1312 toJSON = Number . fromIntegral

1367 toJSON = Number . fromIntegral

1313 {-# INLINE toJSON #-}

1368 {-# INLINE toJSON #-}

1314

1369

1315− toEncoding = Encoding . B.word64Dec

1370+ toEncoding = E.word64

1316 {-# INLINE toEncoding #-}

1371 {-# INLINE toEncoding #-}

1317

1372

1373+instance ToJSONKey Word64 where

1374+ toJSONKey = toJSONKeyTextEnc E.word64Text

1375+ {-# INLINE toJSONKey #-}

1376+

1377+

1318instance ToJSON Text where

1378instance ToJSON Text where

1319 toJSON = String

1379 toJSON = String

1320 {-# INLINE toJSON #-}

1380 {-# INLINE toJSON #-}

1321

1381

1322− toEncoding = Encoding . EB.text

1382+ toEncoding = E.text

1323 {-# INLINE toEncoding #-}

1383 {-# INLINE toEncoding #-}

1324

1384

1385+instance ToJSONKey Text where

1386+ toJSONKey = ToJSONKeyText (id, toEncoding)

1387+ {-# INLINE toJSONKey #-}

1388+

1325instance ToJSON LT.Text where

1389instance ToJSON LT.Text where

1326 toJSON = String . LT.toStrict

1390 toJSON = String . LT.toStrict

1327 {-# INLINE toJSON #-}

1391 {-# INLINE toJSON #-}

@@ -1365,9 +1429,12 @@ instance ToJSON Scientific where

1365 toJSON = Number

1429 toJSON = Number

1366 {-# INLINE toJSON #-}

1430 {-# INLINE toJSON #-}

1367

1431

1368− toEncoding = Encoding . EB.number

1432+ toEncoding = E.scientific

1369 {-# INLINE toEncoding #-}

1433 {-# INLINE toEncoding #-}

1370

1434

1435+instance ToJSONKey Scientific where

1436+ toJSONKey = toJSONKeyTextEnc E.scientificText

1437+

1371-------------------------------------------------------------------------------

1438-------------------------------------------------------------------------------

1372-- DList

1439-- DList

1373-------------------------------------------------------------------------------

1440-------------------------------------------------------------------------------

@@ -1669,7 +1736,7 @@ instance ToJSON NominalDiffTime where

1669 toJSON = Number . realToFrac

1736 toJSON = Number . realToFrac

1670 {-# INLINE toJSON #-}

1737 {-# INLINE toJSON #-}

1671

1738

1672− toEncoding = Encoding . EB.number . realToFrac

1739+ toEncoding = Encoding . EB.scientific . realToFrac

1673 {-# INLINE toEncoding #-}

1740 {-# INLINE toEncoding #-}

1674

1741

1675-------------------------------------------------------------------------------

1742-------------------------------------------------------------------------------

@@ -1755,21 +1822,14 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where

1755-- Instances for converting t map keys

1822-- Instances for converting t map keys

1756-------------------------------------------------------------------------------

1823-------------------------------------------------------------------------------

1757

1824

1758−instance ToJSONKey Text where

1825+-- | TODO: Move ToJSONKEyFunction to .Types(.Internal),

1759− toJSONKey = ToJSONKeyText (id,toEncoding)

1826+-- export and document this function from there

1760−

1827+toJSONKeyTextEnc :: (a -> Encoding) -> ToJSONKeyFunction a

1761−

1828+toJSONKeyTextEnc e = ToJSONKeyText

1762−instance ToJSONKey Bool where

1829+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm

1763− toJSONKey = ToJSONKeyText

1830+ ( T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . B.toLazyByteString . fromEncoding . e

1764− ( (\x -> if x then "true" else "false")

1831+ , e

1765− , (\x -> Encoding $ if x then "\"true\"" else "\"false\"")

1766− )

1767−

1768−instance ToJSONKey Int where

1769− toJSONKey = ToJSONKeyText

1770− ( LT.toStrict . LTB.toLazyText . LTBI.decimal

1771− , \x -> Encoding $ B.char7 '"' <> fromEncoding (toEncoding x) <> B.char7 '"'

1772− )

1832+ )

1773

1833

1774instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)

1834instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)

1775instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)

1835instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)

tests/Properties.hs+8−4

@@ -15,6 +15,7 @@ import Data.DList (DList)

15import Data.Hashable (Hashable)

16import Data.HashMap.Strict (HashMap)

17import Data.Map (Map)

18+import Data.Ratio (Ratio)

18import Data.List.NonEmpty (NonEmpty)

19import Data.List.NonEmpty (NonEmpty)

19import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,

20import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,

20 ZonedTime)

21 ZonedTime)

@@ -80,9 +81,6 @@ infix 4 ==~

80x ==~ y =

81x ==~ y =

81 counterexample (show x ++ " /= " ++ show y) (x =~ y)

82 counterexample (show x ++ " /= " ++ show y) (x =~ y)

83−roundTripApproxEq :: (ApproxEq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

84−roundTripApproxEq x y = roundTripEnc (==~) x y .&&. roundTripNoEnc (==~) x y

85−

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

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

87toFromJSON x = case ifromJSON (toJSON x) of

85toFromJSON x = case ifromJSON (toJSON x) of

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

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

@@ -152,7 +150,7 @@ tests = testGroup "properties" [

152 , testProperty "Text" $ roundTripEq T.empty

150 , testProperty "Text" $ roundTripEq T.empty

153 , testProperty "Foo" $ roundTripEq (undefined :: Foo)

151 , testProperty "Foo" $ roundTripEq (undefined :: Foo)

154 , testProperty "Day" $ roundTripEq (undefined :: Day)

152 , testProperty "Day" $ roundTripEq (undefined :: Day)

155− , testProperty "DotNetTime" $ roundTripApproxEq (undefined :: DotNetTime)

153+ , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)

156 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

154 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

157 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

155 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

158 , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)

156 , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)

@@ -165,6 +163,8 @@ tests = testGroup "properties" [

165 , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)

163 , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)

166 , testProperty "DList" $ roundTripEq (undefined :: DList Int)

164 , testProperty "DList" $ roundTripEq (undefined :: DList Int)

167 , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)

165 , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)

166+ , testProperty "Rational" $ roundTripEq (undefined :: Rational)

167+ , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)

168 , testGroup "ghcGenerics" [

169 testProperty "OneConstructor" $ roundTripEq OneConstructor

170 , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)

@@ -179,6 +179,10 @@ tests = testGroup "properties" [

179 , testProperty "Int" $ roundTripKey (undefined :: Int)

180 , testProperty "[Text]" $ roundTripKey (undefined :: [T.Text])

181 , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))

182+ , testProperty "Integer" $ roundTripKey (undefined :: Integer)

183+ , testProperty "Natural" $ roundTripKey (undefined :: Natural)

184+ , testProperty "Float" $ roundTripKey (undefined :: Float)

185+ , testProperty "Double" $ roundTripKey (undefined :: Double)

182 ]

186 ]

183 , testGroup "toFromJSON" [

187 , testGroup "toFromJSON" [

184 testProperty "Integer" (toFromJSON :: Integer -> Property)

188 testProperty "Integer" (toFromJSON :: Integer -> Property)

tests/UnitTests.hs+8

@@ -37,6 +37,7 @@ import qualified Data.Text.Lazy.Encoding as LT

38import qualified Data.Sequence as Seq

39import qualified Data.DList as DList

40+import qualified Data.HashMap.Strict as HM

41tests :: Test

42tests :: Test

42tests = testGroup "unit" [

43tests = testGroup "unit" [

@@ -246,6 +247,13 @@ jsonEncoding = [

246 , assertEqual "Seq" "[1,2,3]" $ encode (Seq.fromList [1, 2, 3] :: Seq.Seq Int)

247 , assertEqual "Seq" "[1,2,3]" $ encode (Seq.fromList [1, 2, 3] :: Seq.Seq Int)

247 , assertEqual "DList" "[1,2,3]" $ encode (DList.fromList [1, 2, 3] :: DList.DList Int)

248 , assertEqual "DList" "[1,2,3]" $ encode (DList.fromList [1, 2, 3] :: DList.DList Int)

248 , assertEqual "()" "[]" $ encode ()

249 , assertEqual "()" "[]" $ encode ()

250+ , assertEqual "HashMap Int Int" "{\"0\":1,\"2\":3}" $ encode (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)

251+ , assertEqual "nan :: Double" "null" $ encode (0/0 :: Double)

252+ , assertEqual "inf :: Double" "null" $ encode (1/0 :: Double)

253+ -- Three separate cases, as ordering in HashMap is not defined

254+ , assertEqual "HashMap Float Int, NaN" "{\"NaN\":1}" $ encode (HM.singleton (0/0) 1 :: HM.HashMap Float Int)

255+ , assertEqual "HashMap Float Int, Infinity" "{\"Infinity\":1}" $ encode (HM.singleton (1/0) 1 :: HM.HashMap Float Int)

256+ , assertEqual "HashMap Float Int, +Infinity" "{\"-Infinity\":1}" $ encode (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)

249 ]

257 ]

250

258

251jsonDecoding :: [Assertion]

259jsonDecoding :: [Assertion]