692ed3c · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Add direct encoding support

692ed3cBryan O'Sullivan11 years ago

Data/Aeson/Encode/ByteString.hs+48−10

compare with master

unifiedsplit

@@ -18,16 +18,28 @@ module Data.Aeson.Encode.ByteString

18 , null_

19 , bool

20 , array

21+ , emptyArray_

22+ , emptyObject_

21 , object

23 , object

22 , text

24 , text

25+ , unquoted

23 , number

26 , number

27+ , foldable

28+ , series

29+ , ascii2

30+ , ascii4

31+ , ascii5

32+ , ascii6

33+ , ascii7

24 ) where

34 ) where

26−import Data.Aeson.Types (ToJSON(..), Value(..))

36+import Data.Aeson.Types.Class (ToJSON(..))

37+import Data.Aeson.Types.Internal (Value(..), Series(..))

27import Data.ByteString.Builder as B

38import Data.ByteString.Builder as B

28import Data.ByteString.Builder.Prim as BP

39import Data.ByteString.Builder.Prim as BP

29import Data.ByteString.Builder.Scientific (scientificBuilder)

40import Data.ByteString.Builder.Scientific (scientificBuilder)

30import Data.Char (ord)

41import Data.Char (ord)

42+import Data.Foldable (Foldable, foldMap)

31import Data.Monoid ((<>))

43import Data.Monoid ((<>))

32import Data.Scientific (Scientific, base10Exponent, coefficient)

44import Data.Scientific (Scientific, base10Exponent, coefficient)

33import Data.Word (Word8)

45import Data.Word (Word8)

@@ -86,8 +98,11 @@ object m = case HMS.toList m of

87-- | Encode a JSON string.

99-- | Encode a JSON string.

88text :: T.Text -> Builder

100text :: T.Text -> Builder

89−text t =

101+text t = B.char8 '"' <> unquoted t <> B.char8 '"'

102+

103+-- | Encode a JSON string, without enclosing quotes.

104+unquoted :: T.Text -> Builder

90− B.char8 '"' <> TE.encodeUtf8BuilderEscaped escapeAscii t <> B.char8 '"'

105+unquoted t = TE.encodeUtf8BuilderEscaped escapeAscii t

91 where

106 where

92 escapeAscii :: BP.BoundedPrim Word8

107 escapeAscii :: BP.BoundedPrim Word8

93 escapeAscii =

108 escapeAscii =

@@ -103,7 +118,7 @@ text t =

103

118

104 hexEscape :: BP.FixedPrim Word8

119 hexEscape :: BP.FixedPrim Word8

105 hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<

120 hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<

106− BP.char8 BP.>*< BP.char8 BP.>*< BP.word16HexFixed

121+ BP.char8 >*< BP.char8 >*< BP.word16HexFixed

107

122

108-- | Encode a JSON number.

123-- | Encode a JSON number.

109number :: Scientific -> Builder

124number :: Scientific -> Builder

@@ -113,17 +128,40 @@ number s

113 where

128 where

114 e = base10Exponent s

129 e = base10Exponent s

115

130

131+foldable :: (Foldable t, ToJSON a) => t a -> Builder

132+foldable = series '[' ']' . foldMap (Value . toEncoding)

133+

134+series :: Char -> Char -> Series -> Builder

135+series begin end (Value v) = B.char7 begin <> v <> B.char7 end

136+series begin end Empty = BP.primBounded (ascii2 (begin,end)) ()

137+

138+emptyArray_ :: Builder

139+emptyArray_ = BP.primBounded (ascii2 ('[',']')) ()

140+

141+emptyObject_ :: Builder

142+emptyObject_ = BP.primBounded (ascii2 ('{','}')) ()

116

143

117−{-# INLINE ascii2 #-}

118ascii2 :: (Char, Char) -> BP.BoundedPrim a

144ascii2 :: (Char, Char) -> BP.BoundedPrim a

119−ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 BP.>*< BP.char7

145+ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 >*< BP.char7

146+{-# INLINE ascii2 #-}

120

147

121−{-# INLINE ascii4 #-}

122ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a

148ascii4 :: (Char, (Char, (Char, Char))) -> BP.BoundedPrim a

123ascii4 cs = BP.liftFixedToBounded $ (const cs) >$<

149ascii4 cs = BP.liftFixedToBounded $ (const cs) >$<

124− BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7

150+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7

151+{-# INLINE ascii4 #-}

125

152

126−{-# INLINE ascii5 #-}

127ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a

153ascii5 :: (Char, (Char, (Char, (Char, Char)))) -> BP.BoundedPrim a

128ascii5 cs = BP.liftFixedToBounded $ (const cs) >$<

154ascii5 cs = BP.liftFixedToBounded $ (const cs) >$<

155+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7

156+{-# INLINE ascii5 #-}

157+

158+ascii6 :: (Char, (Char, (Char, (Char, (Char, Char))))) -> BP.BoundedPrim a

159+ascii6 cs = BP.liftFixedToBounded $ (const cs) >$<

160+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7

161+{-# INLINE ascii6 #-}

162+

163+ascii7 :: (Char, (Char, (Char, (Char, (Char, (Char, Char)))))) -> BP.BoundedPrim a

164+ascii7 cs = BP.liftFixedToBounded $ (const cs) >$<

129− BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7

165+ BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*< BP.char7 >*<

166+ BP.char7 >*< BP.char7

167+{-# INLINE ascii7 #-}

Data/Aeson/Types.hs+1

@@ -13,6 +13,7 @@ module Data.Aeson.Types

13 (

14 -- * Core JSON types

15 Value(..)

16+ , Encoding

16 , Array

17 , Array

17 , emptyArray

18 , emptyArray

18 , Pair

19 , Pair

Data/Aeson/Types/Class.hs+21−4

@@ -2,7 +2,7 @@

3-- |

4-- Module: Data.Aeson.Types.Class

7-- License: Apache

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

@@ -21,6 +21,7 @@ module Data.Aeson.Types.Class

21 , GFromJSON(..)

22 , GToJSON(..)

23 , genericToJSON

24+ , genericToEncoding

24 , genericParseJSON

25 , genericParseJSON

25 ) where

26 ) where

@@ -33,18 +34,28 @@ class GToJSON f where

33 -- default generic implementation of 'toJSON'.

34 -- default generic implementation of 'toJSON'.

34 gToJSON :: Options -> f a -> Value

35 gToJSON :: Options -> f a -> Value

37+ -- | This method (applied to 'defaultOptions') is used as the

38+ -- default generic implementation of 'toEncoding'.

39+ gToEncoding :: Options -> f a -> Encoding

40+

36-- | Class of generic representation types ('Rep') that can be converted from JSON.

41-- | Class of generic representation types ('Rep') that can be converted from JSON.

37class GFromJSON f where

42class GFromJSON f where

38 -- | This method (applied to 'defaultOptions') is used as the

43 -- | This method (applied to 'defaultOptions') is used as the

39 -- default generic implementation of 'parseJSON'.

44 -- default generic implementation of 'parseJSON'.

40 gParseJSON :: Options -> Value -> Parser (f a)

45 gParseJSON :: Options -> Value -> Parser (f a)

42−-- | A configurable generic JSON encoder. This function applied to

47+-- | A configurable generic JSON creator. This function applied to

43-- 'defaultOptions' is used as the default for 'toJSON' when the type

48-- 'defaultOptions' is used as the default for 'toJSON' when the type

44-- is an instance of 'Generic'.

49-- is an instance of 'Generic'.

45genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value

50genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value

46genericToJSON opts = gToJSON opts . from

51genericToJSON opts = gToJSON opts . from

53+-- | A configurable generic JSON encoder. This function applied to

54+-- 'defaultOptions' is used as the default for 'toEncoding' when the type

55+-- is an instance of 'Generic'.

56+genericToEncoding :: (Generic a, GToJSON (Rep a)) => Options -> a -> Encoding

57+genericToEncoding opts = gToEncoding opts . from

58+

48-- | A configurable generic JSON decoder. This function applied to

59-- | A configurable generic JSON decoder. This function applied to

49-- 'defaultOptions' is used as the default for 'parseJSON' when the

60-- 'defaultOptions' is used as the default for 'parseJSON' when the

50-- type is an instance of 'Generic'.

61-- type is an instance of 'Generic'.

@@ -101,14 +112,20 @@ genericParseJSON opts = fmap to . gParseJSON opts

101--

112--

102-- @

113-- @

103-- instance ToJSON Coord where

114-- instance ToJSON Coord where

104−-- toJSON = 'genericToJSON' 'defaultOptions'

115+-- toJSON = 'genericToJSON' 'defaultOptions'

116+-- toEncoding = 'genericToEncoding' 'defaultOptions'

105-- @

117-- @

106class ToJSON a where

118class ToJSON a where

107− toJSON :: a -> Value

119+ toJSON :: a -> Value

108

120

109 default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value

121 default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value

110 toJSON = genericToJSON defaultOptions

122 toJSON = genericToJSON defaultOptions

111

123

124+ toEncoding :: a -> Encoding

125+

126+ default toEncoding :: (Generic a, GToJSON (Rep a)) => a -> Encoding

127+ toEncoding = genericToEncoding defaultOptions

128+

112-- | A type that can be converted from JSON, with the possibility of

129-- | A type that can be converted from JSON, with the possibility of

113-- failure.

130-- failure.

114--

131--

Data/Aeson/Types/Generic.hs+182−43

@@ -25,9 +25,11 @@ import Control.Monad.ST (ST)

25import Data.Aeson.Types.Instances

26import Data.Aeson.Types.Internal

27import Data.Bits

28+import Data.Aeson.Encode.ByteString (emptyArray_)

29+import Data.ByteString.Builder as B

30+import Data.Monoid ((<>), mempty)

28import Data.DList (DList, toList, empty)

31import Data.DList (DList, toList, empty)

29import Data.Maybe (fromMaybe)

32import Data.Maybe (fromMaybe)

30−import Data.Monoid (mappend)

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

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

32import GHC.Generics

34import GHC.Generics

33import qualified Data.HashMap.Strict as H

35import qualified Data.HashMap.Strict as H

@@ -42,22 +44,34 @@ instance (GToJSON a) => GToJSON (M1 i c a) where

42 gToJSON opts = gToJSON opts . unM1

44 gToJSON opts = gToJSON opts . unM1

43 {-# INLINE gToJSON #-}

45 {-# INLINE gToJSON #-}

47+ gToEncoding opts = gToEncoding opts . unM1

48+ {-# INLINE gToEncoding #-}

49+

45instance (ToJSON a) => GToJSON (K1 i a) where

50instance (ToJSON a) => GToJSON (K1 i a) where

46 -- Constant values are encoded using their ToJSON instance:

51 -- Constant values are encoded using their ToJSON instance:

47 gToJSON _opts = toJSON . unK1

52 gToJSON _opts = toJSON . unK1

48 {-# INLINE gToJSON #-}

53 {-# INLINE gToJSON #-}

55+ gToEncoding _opts = toEncoding . unK1

56+ {-# INLINE gToEncoding #-}

57+

50instance GToJSON U1 where

58instance GToJSON U1 where

51 -- Empty constructors are encoded to an empty array:

59 -- Empty constructors are encoded to an empty array:

52 gToJSON _opts _ = emptyArray

60 gToJSON _opts _ = emptyArray

53 {-# INLINE gToJSON #-}

61 {-# INLINE gToJSON #-}

63+ gToEncoding _opts _ = emptyArray_

64+ {-# INLINE gToEncoding #-}

65+

55instance (ConsToJSON a) => GToJSON (C1 c a) where

66instance (ConsToJSON a) => GToJSON (C1 c a) where

56 -- Constructors need to be encoded differently depending on whether they're

67 -- Constructors need to be encoded differently depending on whether they're

57− -- a record or not. This distinction is made by 'constToJSON':

68+ -- a record or not. This distinction is made by 'consToJSON':

58 gToJSON opts = consToJSON opts . unM1

69 gToJSON opts = consToJSON opts . unM1

59 {-# INLINE gToJSON #-}

70 {-# INLINE gToJSON #-}

72+ gToEncoding opts = consToEncoding opts . unM1

73+ {-# INLINE gToEncoding #-}

74+

61instance ( WriteProduct a, WriteProduct b

75instance ( WriteProduct a, WriteProduct b

62 , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where

76 , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where

63 -- Products are encoded to an array. Here we allocate a mutable vector of

77 -- Products are encoded to an array. Here we allocate a mutable vector of

@@ -73,6 +87,8 @@ instance ( WriteProduct a, WriteProduct b

73 productSize

87 productSize

74 {-# INLINE gToJSON #-}

88 {-# INLINE gToJSON #-}

90+ gToEncoding opts p = B.char7 '[' <> encodeProduct opts p <> B.char7 ']'

91+

76instance ( AllNullary (a :+: b) allNullary

92instance ( AllNullary (a :+: b) allNullary

77 , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where

93 , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where

78 -- If all constructors of a sum datatype are nullary and the

94 -- If all constructors of a sum datatype are nullary and the

@@ -82,13 +98,18 @@ instance ( AllNullary (a :+: b) allNullary

82 . sumToJSON opts

98 . sumToJSON opts

83 {-# INLINE gToJSON #-}

99 {-# INLINE gToJSON #-}

100

101+ gToEncoding opts = (unTagged :: Tagged allNullary B.Builder -> B.Builder)

102+ . sumToEncoding opts

103+ {-# INLINE gToEncoding #-}

104+

85--------------------------------------------------------------------------------

105--------------------------------------------------------------------------------

106

87class SumToJSON f allNullary where

107class SumToJSON f allNullary where

88 sumToJSON :: Options -> f a -> Tagged allNullary Value

108 sumToJSON :: Options -> f a -> Tagged allNullary Value

109+ sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder

110

90instance ( GetConName f

111instance ( GetConName f

91− , TaggedObject f

112+ , TaggedObject f

92 , ObjectWithSingleField f

113 , ObjectWithSingleField f

93 , TwoElemArray f ) => SumToJSON f True where

114 , TwoElemArray f ) => SumToJSON f True where

94 sumToJSON opts

115 sumToJSON opts

@@ -97,11 +118,19 @@ instance ( GetConName f

97 | otherwise = Tagged . nonAllNullarySumToJSON opts

118 | otherwise = Tagged . nonAllNullarySumToJSON opts

98 {-# INLINE sumToJSON #-}

119 {-# INLINE sumToJSON #-}

120

121+ sumToEncoding opts

122+ | allNullaryToStringTag opts = Tagged . toEncoding .

123+ constructorTagModifier opts . getConName

124+ | otherwise = Tagged . nonAllNullarySumToEncoding opts

125+ {-# INLINE sumToEncoding #-}

126+

100instance ( TwoElemArray f

127instance ( TwoElemArray f

101 , TaggedObject f

128 , TaggedObject f

102 , ObjectWithSingleField f ) => SumToJSON f False where

129 , ObjectWithSingleField f ) => SumToJSON f False where

103 sumToJSON opts = Tagged . nonAllNullarySumToJSON opts

130 sumToJSON opts = Tagged . nonAllNullarySumToJSON opts

104 {-# INLINE sumToJSON #-}

131 {-# INLINE sumToJSON #-}

132+ sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts

133+ {-# INLINE sumToEncoding #-}

105

134

106nonAllNullarySumToJSON :: ( TwoElemArray f

135nonAllNullarySumToJSON :: ( TwoElemArray f

107 , TaggedObject f

136 , TaggedObject f

@@ -109,46 +138,85 @@ nonAllNullarySumToJSON :: ( TwoElemArray f

109 ) => Options -> f a -> Value

138 ) => Options -> f a -> Value

110nonAllNullarySumToJSON opts =

139nonAllNullarySumToJSON opts =

111 case sumEncoding opts of

140 case sumEncoding opts of

112− TaggedObject{..} -> object . taggedObject opts tagFieldName

141+ TaggedObject{..} ->

113− contentsFieldName

142+ object . taggedObjectPairs opts tagFieldName contentsFieldName

114− ObjectWithSingleField -> Object . objectWithSingleField opts

143+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts

115− TwoElemArray -> Array . twoElemArray opts

144+ TwoElemArray -> Array . twoElemArrayObj opts

116{-# INLINE nonAllNullarySumToJSON #-}

145{-# INLINE nonAllNullarySumToJSON #-}

117

146

147+nonAllNullarySumToEncoding :: ( TwoElemArray f

148+ , TaggedObject f

149+ , ObjectWithSingleField f

150+ ) => Options -> f a -> B.Builder

151+nonAllNullarySumToEncoding opts =

152+ case sumEncoding opts of

153+ TaggedObject{..} ->

154+ taggedObjectEnc opts tagFieldName contentsFieldName

155+ ObjectWithSingleField -> objectWithSingleFieldEnc opts

156+ TwoElemArray -> twoElemArrayEnc opts

157+{-# INLINE nonAllNullarySumToEncoding #-}

158+

118--------------------------------------------------------------------------------

159--------------------------------------------------------------------------------

119

160

120class TaggedObject f where

161class TaggedObject f where

121− taggedObject :: Options -> String -> String -> f a -> [Pair]

162+ taggedObjectPairs :: Options -> String -> String -> f a -> [Pair]

163+ taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder

122

164

123instance ( TaggedObject a

165instance ( TaggedObject a

124 , TaggedObject b ) => TaggedObject (a :+: b) where

166 , TaggedObject b ) => TaggedObject (a :+: b) where

167+ taggedObjectPairs opts tagFieldName contentsFieldName (L1 x) =

168+ taggedObjectPairs opts tagFieldName contentsFieldName x

169+ taggedObjectPairs opts tagFieldName contentsFieldName (R1 x) =

170+ taggedObjectPairs opts tagFieldName contentsFieldName x

171+ {-# INLINE taggedObjectPairs #-}

172+

125− taggedObject opts tagFieldName contentsFieldName (L1 x) =

173+ taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =

126− taggedObject opts tagFieldName contentsFieldName x

174+ taggedObjectEnc opts tagFieldName contentsFieldName x

127− taggedObject opts tagFieldName contentsFieldName (R1 x) =

175+ taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =

128− taggedObject opts tagFieldName contentsFieldName x

176+ taggedObjectEnc opts tagFieldName contentsFieldName x

129− {-# INLINE taggedObject #-}

177+ {-# INLINE taggedObjectEnc #-}

130

178

131instance ( IsRecord a isRecord

179instance ( IsRecord a isRecord

132 , TaggedObject' a isRecord

180 , TaggedObject' a isRecord

133 , Constructor c ) => TaggedObject (C1 c a) where

181 , Constructor c ) => TaggedObject (C1 c a) where

134− taggedObject opts tagFieldName contentsFieldName =

182+ taggedObjectPairs opts tagFieldName contentsFieldName =

135 (pack tagFieldName .= constructorTagModifier opts

183 (pack tagFieldName .= constructorTagModifier opts

136 (conName (undefined :: t c a p)) :) .

184 (conName (undefined :: t c a p)) :) .

137 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .

185 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .

186+ taggedObjectPairs' opts contentsFieldName . unM1

187+ {-# INLINE taggedObjectPairs #-}

188+

189+ taggedObjectEnc opts tagFieldName contentsFieldName v =

190+ B.char7 '{' <>

191+ (toEncoding tagFieldName <>

192+ B.char7 ':' <>

193+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>

194+ B.char7 ',' <>

195+ ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .

138− taggedObject' opts contentsFieldName . unM1

196+ taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>

139− {-# INLINE taggedObject #-}

197+ B.char7 '}'

198+ {-# INLINE taggedObjectEnc #-}

140

199

141class TaggedObject' f isRecord where

200class TaggedObject' f isRecord where

142− taggedObject' :: Options -> String -> f a -> Tagged isRecord [Pair]

201+ taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]

202+ taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder

203+

204+instance (RecordTo f) => TaggedObject' f True where

205+ taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts

206+ {-# INLINE taggedObjectPairs' #-}

143

207

144−instance (RecordToPairs f) => TaggedObject' f True where

208+ taggedObjectEnc' opts _ = Tagged . recordToEncoding opts

145− taggedObject' opts _ = Tagged . toList . recordToPairs opts

209+ {-# INLINE taggedObjectEnc' #-}

146− {-# INLINE taggedObject' #-}

147

210

148instance (GToJSON f) => TaggedObject' f False where

211instance (GToJSON f) => TaggedObject' f False where

149− taggedObject' opts contentsFieldName =

212+ taggedObjectPairs' opts contentsFieldName =

150 Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts

213 Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts

151− {-# INLINE taggedObject' #-}

214+ {-# INLINE taggedObjectPairs' #-}

215+

216+ taggedObjectEnc' opts contentsFieldName =

217+ Tagged . (\z -> toEncoding contentsFieldName <> B.char7 ':' <> z) .

218+ gToEncoding opts

219+ {-# INLINE taggedObjectEnc' #-}

152

220

153--------------------------------------------------------------------------------

221--------------------------------------------------------------------------------

154

222

@@ -168,30 +236,45 @@ instance (Constructor c, GToJSON a, ConsToJSON a) => GetConName (C1 c a) where

168--------------------------------------------------------------------------------

236--------------------------------------------------------------------------------

169

237

170class TwoElemArray f where

238class TwoElemArray f where

171− twoElemArray :: Options -> f a -> V.Vector Value

239+ twoElemArrayObj :: Options -> f a -> V.Vector Value

240+ twoElemArrayEnc :: Options -> f a -> B.Builder

172

241

173instance (TwoElemArray a, TwoElemArray b) => TwoElemArray (a :+: b) where

242instance (TwoElemArray a, TwoElemArray b) => TwoElemArray (a :+: b) where

174− twoElemArray opts (L1 x) = twoElemArray opts x

243+ twoElemArrayObj opts (L1 x) = twoElemArrayObj opts x

175− twoElemArray opts (R1 x) = twoElemArray opts x

244+ twoElemArrayObj opts (R1 x) = twoElemArrayObj opts x

176− {-# INLINE twoElemArray #-}

245+ {-# INLINE twoElemArrayObj #-}

246+

247+ twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x

248+ twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x

249+ {-# INLINE twoElemArrayEnc #-}

177

250

178instance ( GToJSON a, ConsToJSON a

251instance ( GToJSON a, ConsToJSON a

179 , Constructor c ) => TwoElemArray (C1 c a) where

252 , Constructor c ) => TwoElemArray (C1 c a) where

180− twoElemArray opts x = V.create $ do

253+ twoElemArrayObj opts x = V.create $ do

181 mv <- VM.unsafeNew 2

254 mv <- VM.unsafeNew 2

182 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts

255 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts

183 $ conName (undefined :: t c a p)

256 $ conName (undefined :: t c a p)

184 VM.unsafeWrite mv 1 $ gToJSON opts x

257 VM.unsafeWrite mv 1 $ gToJSON opts x

185 return mv

258 return mv

186− {-# INLINE twoElemArray #-}

259+ {-# INLINE twoElemArrayObj #-}

260+

261+ twoElemArrayEnc opts x =

262+ B.char7 '[' <>

263+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) <>

264+ B.char7 ',' <>

265+ gToEncoding opts x <>

266+ B.char7 ']'

267+ {-# INLINE twoElemArrayEnc #-}

187

268

188--------------------------------------------------------------------------------

269--------------------------------------------------------------------------------

189

270

190class ConsToJSON f where

271class ConsToJSON f where

191− consToJSON :: Options -> f a -> Value

272+ consToJSON :: Options -> f a -> Value

273+ consToEncoding :: Options -> f a -> B.Builder

192

274

193class ConsToJSON' f isRecord where

275class ConsToJSON' f isRecord where

194− consToJSON' :: Options -> f a -> Tagged isRecord Value

276+ consToJSON' :: Options -> f a -> Tagged isRecord Value

277+ consToEncoding' :: Options -> f a -> Tagged isRecord B.Builder

195

278

196instance ( IsRecord f isRecord

279instance ( IsRecord f isRecord

197 , ConsToJSON' f isRecord ) => ConsToJSON f where

280 , ConsToJSON' f isRecord ) => ConsToJSON f where

@@ -199,40 +282,73 @@ instance ( IsRecord f isRecord

199 . consToJSON' opts

282 . consToJSON' opts

200 {-# INLINE consToJSON #-}

283 {-# INLINE consToJSON #-}

201

284

285+ consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)

286+ . consToEncoding' opts

287+ {-# INLINE consToEncoding #-}

288+

202−instance (RecordToPairs f) => ConsToJSON' f True where

289+instance (RecordTo f) => ConsToJSON' f True where

203 consToJSON' opts = Tagged . object . toList . recordToPairs opts

290 consToJSON' opts = Tagged . object . toList . recordToPairs opts

204 {-# INLINE consToJSON' #-}

291 {-# INLINE consToJSON' #-}

205

292

293+ consToEncoding' opts x = Tagged $

294+ B.char7 '{' <>

295+ recordToEncoding opts x <>

296+ B.char7 '}'

297+ {-# INLINE consToEncoding' #-}

298+

206instance GToJSON f => ConsToJSON' f False where

299instance GToJSON f => ConsToJSON' f False where

207 consToJSON' opts = Tagged . gToJSON opts

300 consToJSON' opts = Tagged . gToJSON opts

208 {-# INLINE consToJSON' #-}

301 {-# INLINE consToJSON' #-}

302+ consToEncoding' opts = Tagged . gToEncoding opts

303+ {-# INLINE consToEncoding' #-}

209

304

210--------------------------------------------------------------------------------

305--------------------------------------------------------------------------------

211

306

212−class RecordToPairs f where

307+class RecordTo f where

213− recordToPairs :: Options -> f a -> DList Pair

308+ recordToPairs :: Options -> f a -> DList Pair

309+ recordToEncoding :: Options -> f a -> B.Builder

214

310

215−instance (RecordToPairs a, RecordToPairs b) => RecordToPairs (a :*: b) where

311+instance (RecordTo a, RecordTo b) => RecordTo (a :*: b) where

216− recordToPairs opts (a :*: b) = recordToPairs opts a `mappend`

312+ recordToPairs opts (a :*: b) = recordToPairs opts a <>

217 recordToPairs opts b

313 recordToPairs opts b

218 {-# INLINE recordToPairs #-}

314 {-# INLINE recordToPairs #-}

219

315

316+ recordToEncoding opts (a :*: b) = recordToEncoding opts a <>

317+ B.char7 ',' <>

318+ recordToEncoding opts b

319+ {-# INLINE recordToEncoding #-}

320+

220−instance (Selector s, GToJSON a) => RecordToPairs (S1 s a) where

321+instance (Selector s, GToJSON a) => RecordTo (S1 s a) where

221 recordToPairs = fieldToPair

322 recordToPairs = fieldToPair

222 {-# INLINE recordToPairs #-}

323 {-# INLINE recordToPairs #-}

223

324

325+ recordToEncoding = fieldToEncoding

326+ {-# INLINE recordToEncoding #-}

327+

224−instance (Selector s, ToJSON a) => RecordToPairs (S1 s (K1 i (Maybe a))) where

328+instance (Selector s, ToJSON a) => RecordTo (S1 s (K1 i (Maybe a))) where

225 recordToPairs opts (M1 k1) | omitNothingFields opts

329 recordToPairs opts (M1 k1) | omitNothingFields opts

226 , K1 Nothing <- k1 = empty

330 , K1 Nothing <- k1 = empty

227 recordToPairs opts m1 = fieldToPair opts m1

331 recordToPairs opts m1 = fieldToPair opts m1

228 {-# INLINE recordToPairs #-}

332 {-# INLINE recordToPairs #-}

229

333

334+ recordToEncoding opts (M1 k1) | omitNothingFields opts

335+ , K1 Nothing <- k1 = mempty

336+ recordToEncoding opts m1 = fieldToEncoding opts m1

337+ {-# INLINE recordToEncoding #-}

338+

230fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair

339fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair

231fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1

340fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1

232 , gToJSON opts (unM1 m1)

341 , gToJSON opts (unM1 m1)

233 )

342 )

234{-# INLINE fieldToPair #-}

343{-# INLINE fieldToPair #-}

235

344

345+fieldToEncoding :: (Selector s, GToJSON a) => Options -> S1 s a p -> B.Builder

346+fieldToEncoding opts m1 =

347+ toEncoding (fieldLabelModifier opts $ selName m1) <>

348+ B.char7 ':' <>

349+ gToEncoding opts (unM1 m1)

350+{-# INLINE fieldToEncoding #-}

351+

236--------------------------------------------------------------------------------

352--------------------------------------------------------------------------------

237

353

238class WriteProduct f where

354class WriteProduct f where

@@ -242,6 +358,7 @@ class WriteProduct f where

242 -> Int -- ^ length

358 -> Int -- ^ length

243 -> f a

359 -> f a

244 -> ST s ()

360 -> ST s ()

361+ encodeProduct :: Options -> f a -> B.Builder

245

362

246instance ( WriteProduct a

363instance ( WriteProduct a

247 , WriteProduct b ) => WriteProduct (a :*: b) where

364 , WriteProduct b ) => WriteProduct (a :*: b) where

@@ -254,28 +371,50 @@ instance ( WriteProduct a

254 ixR = ix + lenL

371 ixR = ix + lenL

255 {-# INLINE writeProduct #-}

372 {-# INLINE writeProduct #-}

256

373

374+ encodeProduct opts (a :*: b) = encodeProduct opts a <>

375+ B.char7 ',' <>

376+ encodeProduct opts b

377+ {-# INLINE encodeProduct #-}

378+

257instance (GToJSON a) => WriteProduct a where

379instance (GToJSON a) => WriteProduct a where

258 writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts

380 writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts

259 {-# INLINE writeProduct #-}

381 {-# INLINE writeProduct #-}

260

382

383+ encodeProduct opts = gToEncoding opts

384+ {-# INLINE encodeProduct #-}

385+

261--------------------------------------------------------------------------------

386--------------------------------------------------------------------------------

262

387

263class ObjectWithSingleField f where

388class ObjectWithSingleField f where

264− objectWithSingleField :: Options -> f a -> Object

389+ objectWithSingleFieldObj :: Options -> f a -> Object

390+ objectWithSingleFieldEnc :: Options -> f a -> B.Builder

265

391

266instance ( ObjectWithSingleField a

392instance ( ObjectWithSingleField a

267 , ObjectWithSingleField b ) => ObjectWithSingleField (a :+: b) where

393 , ObjectWithSingleField b ) => ObjectWithSingleField (a :+: b) where

268− objectWithSingleField opts (L1 x) = objectWithSingleField opts x

394+ objectWithSingleFieldObj opts (L1 x) = objectWithSingleFieldObj opts x

269− objectWithSingleField opts (R1 x) = objectWithSingleField opts x

395+ objectWithSingleFieldObj opts (R1 x) = objectWithSingleFieldObj opts x

270− {-# INLINE objectWithSingleField #-}

396+ {-# INLINE objectWithSingleFieldObj #-}

397+

398+ objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x

399+ objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x

400+ {-# INLINE objectWithSingleFieldEnc #-}

271

401

272instance ( GToJSON a, ConsToJSON a

402instance ( GToJSON a, ConsToJSON a

273 , Constructor c ) => ObjectWithSingleField (C1 c a) where

403 , Constructor c ) => ObjectWithSingleField (C1 c a) where

274− objectWithSingleField opts = H.singleton typ . gToJSON opts

404+ objectWithSingleFieldObj opts = H.singleton typ . gToJSON opts

275 where

405 where

276 typ = pack $ constructorTagModifier opts $

406 typ = pack $ constructorTagModifier opts $

277 conName (undefined :: t c a p)

407 conName (undefined :: t c a p)

278− {-# INLINE objectWithSingleField #-}

408+ {-# INLINE objectWithSingleFieldObj #-}

409+

410+ objectWithSingleFieldEnc opts v =

411+ B.char7 '{' <>

412+ toEncoding (constructorTagModifier opts

413+ (conName (undefined :: t c a p))) <>

414+ B.char7 ':' <>

415+ gToEncoding opts v <>

416+ B.char7 '}'

417+ {-# INLINE objectWithSingleFieldEnc #-}

279

418

280--------------------------------------------------------------------------------

419--------------------------------------------------------------------------------

281-- Generic parseJSON

420-- Generic parseJSON

Data/Aeson/Types/Instances.hs+338−15

@@ -51,14 +51,18 @@ module Data.Aeson.Types.Instances

51 ) where

53import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)

54+import qualified Data.Aeson.Encode.ByteString as E

55+import qualified Data.ByteString.Builder as B

56+import qualified Data.ByteString.Builder.Prim as BP

54import Data.Aeson.Functions

57import Data.Aeson.Functions

58+import Data.Monoid ((<>), mempty)

55import Data.Aeson.Types.Class

59import Data.Aeson.Types.Class

56import Data.Aeson.Types.Internal

60import Data.Aeson.Types.Internal

57import Data.Scientific (Scientific)

61import Data.Scientific (Scientific)

58import qualified Data.Scientific as Scientific (coefficient, base10Exponent, fromFloatDigits, toRealFloat)

62import qualified Data.Scientific as Scientific (coefficient, base10Exponent, fromFloatDigits, toRealFloat)

59import Data.Attoparsec.Number (Number(..))

63import Data.Attoparsec.Number (Number(..))

60import Data.Fixed

64import Data.Fixed

61−import Data.Foldable (toList)

65+import Data.Foldable (Foldable, toList)

62import Data.Functor.Identity (Identity(..))

66import Data.Functor.Identity (Identity(..))

63import Data.Hashable (Hashable(..))

67import Data.Hashable (Hashable(..))

64import Data.Int (Int8, Int16, Int32, Int64)

68import Data.Int (Int8, Int16, Int32, Int64)

@@ -72,6 +76,7 @@ import Data.Traversable (traverse)

72import Data.Vector (Vector)

76import Data.Vector (Vector)

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

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

74import Foreign.Storable (Storable)

78import Foreign.Storable (Storable)

79+import Prelude hiding (foldr)

75import qualified Data.HashMap.Strict as H

80import qualified Data.HashMap.Strict as H

76import qualified Data.HashSet as HashSet

81import qualified Data.HashSet as HashSet

77import qualified Data.IntMap as IntMap

82import qualified Data.IntMap as IntMap

@@ -88,6 +93,7 @@ import qualified Data.Vector.Primitive as VP

88import qualified Data.Vector.Storable as VS

93import qualified Data.Vector.Storable as VS

89import qualified Data.Vector.Unboxed as VU

94import qualified Data.Vector.Unboxed as VU

90import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )

95import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )

96+import qualified Prelude as P

92#if MIN_VERSION_time(1,5,0)

98#if MIN_VERSION_time(1,5,0)

93import Data.Time.Format (defaultTimeLocale, dateTimeFmt)

99import Data.Time.Format (defaultTimeLocale, dateTimeFmt)

@@ -99,6 +105,9 @@ instance (ToJSON a) => ToJSON (Identity a) where

99 toJSON (Identity a) = toJSON a

105 toJSON (Identity a) = toJSON a

100 {-# INLINE toJSON #-}

106 {-# INLINE toJSON #-}

101

107

108+ toEncoding (Identity a) = toEncoding a

109+ {-# INLINE toEncoding #-}

110+

102instance (FromJSON a) => FromJSON (Identity a) where

111instance (FromJSON a) => FromJSON (Identity a) where

103 parseJSON a = Identity <$> parseJSON a

112 parseJSON a = Identity <$> parseJSON a

104 {-# INLINE parseJSON #-}

113 {-# INLINE parseJSON #-}

@@ -108,6 +117,9 @@ instance (ToJSON a) => ToJSON (Maybe a) where

108 toJSON Nothing = Null

117 toJSON Nothing = Null

109 {-# INLINE toJSON #-}

118 {-# INLINE toJSON #-}

110

119

120+ toEncoding (Just a) = toEncoding a

121+ toEncoding Nothing = E.null_

122+

111instance (FromJSON a) => FromJSON (Maybe a) where

123instance (FromJSON a) => FromJSON (Maybe a) where

112 parseJSON Null = pure Nothing

124 parseJSON Null = pure Nothing

113 parseJSON a = Just <$> parseJSON a

125 parseJSON a = Just <$> parseJSON a

@@ -118,6 +130,11 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where

118 toJSON (Right b) = object [right .= b]

130 toJSON (Right b) = object [right .= b]

119 {-# INLINE toJSON #-}

131 {-# INLINE toJSON #-}

120

132

133+ toEncoding (Left a) =

134+ B.shortByteString "{\"left\":" <> toEncoding a <> B.char7 '}'

135+ toEncoding (Right a) =

136+ B.shortByteString "{\"right\":" <> toEncoding a <> B.char7 '}'

137+

121instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where

138instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where

122 parseJSON (Object (H.toList -> [(key, value)]))

139 parseJSON (Object (H.toList -> [(key, value)]))

123 | key == left = Left <$> parseJSON value

140 | key == left = Left <$> parseJSON value

@@ -136,6 +153,8 @@ instance ToJSON Bool where

136 toJSON = Bool

153 toJSON = Bool

137 {-# INLINE toJSON #-}

154 {-# INLINE toJSON #-}

138

155

156+ toEncoding v = E.bool v

157+

139instance FromJSON Bool where

158instance FromJSON Bool where

140 parseJSON = withBool "Bool" pure

159 parseJSON = withBool "Bool" pure

141 {-# INLINE parseJSON #-}

160 {-# INLINE parseJSON #-}

@@ -144,6 +163,8 @@ instance ToJSON () where

144 toJSON _ = emptyArray

163 toJSON _ = emptyArray

145 {-# INLINE toJSON #-}

164 {-# INLINE toJSON #-}

146

165

166+ toEncoding _ = E.emptyArray_

167+

147instance FromJSON () where

168instance FromJSON () where

148 parseJSON = withArray "()" $ \v ->

169 parseJSON = withArray "()" $ \v ->

149 if V.null v

170 if V.null v

@@ -155,6 +176,8 @@ instance ToJSON [Char] where

155 toJSON = String . T.pack

176 toJSON = String . T.pack

156 {-# INLINE toJSON #-}

177 {-# INLINE toJSON #-}

157

178

179+ toEncoding = E.text . T.pack

180+

158instance FromJSON [Char] where

181instance FromJSON [Char] where

159 parseJSON = withText "String" $ pure . T.unpack

182 parseJSON = withText "String" $ pure . T.unpack

160 {-# INLINE parseJSON #-}

183 {-# INLINE parseJSON #-}

@@ -163,6 +186,8 @@ instance ToJSON Char where

163 toJSON = String . T.singleton

186 toJSON = String . T.singleton

164 {-# INLINE toJSON #-}

187 {-# INLINE toJSON #-}

165

188

189+ toEncoding = E.text . T.singleton

190+

166instance FromJSON Char where

191instance FromJSON Char where

167 parseJSON = withText "Char" $ \t ->

192 parseJSON = withText "Char" $ \t ->

168 if T.compareLength t 1 == EQ

193 if T.compareLength t 1 == EQ

@@ -174,6 +199,9 @@ instance ToJSON Scientific where

174 toJSON = Number

199 toJSON = Number

175 {-# INLINE toJSON #-}

200 {-# INLINE toJSON #-}

176

201

202+ toEncoding v = E.number v

203+ {-# INLINE toEncoding #-}

204+

177instance FromJSON Scientific where

205instance FromJSON Scientific where

178 parseJSON = withScientific "Scientific" pure

206 parseJSON = withScientific "Scientific" pure

179 {-# INLINE parseJSON #-}

207 {-# INLINE parseJSON #-}

@@ -182,6 +210,9 @@ instance ToJSON Double where

182 toJSON = realFloatToJSON

210 toJSON = realFloatToJSON

183 {-# INLINE toJSON #-}

211 {-# INLINE toJSON #-}

184

212

213+ toEncoding = realFloatToEncoding

214+ {-# INLINE toEncoding #-}

215+

185instance FromJSON Double where

216instance FromJSON Double where

186 parseJSON = parseRealFloat "Double"

217 parseJSON = parseRealFloat "Double"

187 {-# INLINE parseJSON #-}

218 {-# INLINE parseJSON #-}

@@ -191,6 +222,10 @@ instance ToJSON Number where

191 toJSON (I i) = toJSON i

222 toJSON (I i) = toJSON i

192 {-# INLINE toJSON #-}

223 {-# INLINE toJSON #-}

193

224

225+ toEncoding (D d) = toEncoding d

226+ toEncoding (I i) = toEncoding i

227+ {-# INLINE toEncoding #-}

228+

194instance FromJSON Number where

229instance FromJSON Number where

195 parseJSON (Number s) = pure $ scientificToNumber s

230 parseJSON (Number s) = pure $ scientificToNumber s

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

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

@@ -201,6 +236,9 @@ instance ToJSON Float where

201 toJSON = realFloatToJSON

236 toJSON = realFloatToJSON

202 {-# INLINE toJSON #-}

237 {-# INLINE toJSON #-}

203

238

239+ toEncoding = realFloatToEncoding

240+ {-# INLINE toEncoding #-}

241+

204instance FromJSON Float where

242instance FromJSON Float where

205 parseJSON = parseRealFloat "Float"

243 parseJSON = parseRealFloat "Float"

206 {-# INLINE parseJSON #-}

244 {-# INLINE parseJSON #-}

@@ -209,7 +247,11 @@ instance ToJSON (Ratio Integer) where

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

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

210 , "denominator" .= denominator r

248 , "denominator" .= denominator r

211 ]

249 ]

212− {-# INLINE toJSON #-}

250+

251+ toEncoding r =

252+ B.shortByteString "{\"numerator\":" <> toEncoding (numerator r) <>

253+ B.shortByteString ",\"denominator\":" <> toEncoding (denominator r) <>

254+ B.char7 '}'

213

255

214instance FromJSON (Ratio Integer) where

256instance FromJSON (Ratio Integer) where

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

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

@@ -221,6 +263,8 @@ instance HasResolution a => ToJSON (Fixed a) where

221 toJSON = Number . realToFrac

263 toJSON = Number . realToFrac

222 {-# INLINE toJSON #-}

264 {-# INLINE toJSON #-}

223

265

266+ toEncoding = E.number . realToFrac

267+

224-- | /WARNING:/ Only parse fixed-precision numbers from trusted input

268-- | /WARNING:/ Only parse fixed-precision numbers from trusted input

225-- since an attacker could easily fill up the memory of the target

269-- since an attacker could easily fill up the memory of the target

226-- system by specifying a scientific number with a big exponent like

270-- system by specifying a scientific number with a big exponent like

@@ -233,6 +277,9 @@ instance ToJSON Int where

233 toJSON = Number . fromIntegral

277 toJSON = Number . fromIntegral

234 {-# INLINE toJSON #-}

278 {-# INLINE toJSON #-}

235

279

280+ toEncoding = B.intDec

281+ {-# INLINE toEncoding #-}

282+

236instance FromJSON Int where

283instance FromJSON Int where

237 parseJSON = parseIntegral "Int"

284 parseJSON = parseIntegral "Int"

238 {-# INLINE parseJSON #-}

285 {-# INLINE parseJSON #-}

@@ -241,6 +288,8 @@ instance ToJSON Integer where

241 toJSON = Number . fromInteger

288 toJSON = Number . fromInteger

242 {-# INLINE toJSON #-}

289 {-# INLINE toJSON #-}

243

290

291+ toEncoding = B.integerDec

292+

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

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

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

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

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

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

@@ -253,6 +302,8 @@ instance ToJSON Int8 where

253 toJSON = Number . fromIntegral

302 toJSON = Number . fromIntegral

254 {-# INLINE toJSON #-}

303 {-# INLINE toJSON #-}

255

304

305+ toEncoding = B.int8Dec

306+

256instance FromJSON Int8 where

307instance FromJSON Int8 where

257 parseJSON = parseIntegral "Int8"

308 parseJSON = parseIntegral "Int8"

258 {-# INLINE parseJSON #-}

309 {-# INLINE parseJSON #-}

@@ -261,6 +312,8 @@ instance ToJSON Int16 where

261 toJSON = Number . fromIntegral

312 toJSON = Number . fromIntegral

262 {-# INLINE toJSON #-}

313 {-# INLINE toJSON #-}

263

314

315+ toEncoding = B.int16Dec

316+

264instance FromJSON Int16 where

317instance FromJSON Int16 where

265 parseJSON = parseIntegral "Int16"

318 parseJSON = parseIntegral "Int16"

266 {-# INLINE parseJSON #-}

319 {-# INLINE parseJSON #-}

@@ -269,6 +322,8 @@ instance ToJSON Int32 where

269 toJSON = Number . fromIntegral

322 toJSON = Number . fromIntegral

270 {-# INLINE toJSON #-}

323 {-# INLINE toJSON #-}

271

324

325+ toEncoding = B.int32Dec

326+

272instance FromJSON Int32 where

327instance FromJSON Int32 where

273 parseJSON = parseIntegral "Int32"

328 parseJSON = parseIntegral "Int32"

274 {-# INLINE parseJSON #-}

329 {-# INLINE parseJSON #-}

@@ -277,6 +332,8 @@ instance ToJSON Int64 where

277 toJSON = Number . fromIntegral

332 toJSON = Number . fromIntegral

278 {-# INLINE toJSON #-}

333 {-# INLINE toJSON #-}

279

334

335+ toEncoding = B.int64Dec

336+

280instance FromJSON Int64 where

337instance FromJSON Int64 where

281 parseJSON = parseIntegral "Int64"

338 parseJSON = parseIntegral "Int64"

282 {-# INLINE parseJSON #-}

339 {-# INLINE parseJSON #-}

@@ -285,6 +342,8 @@ instance ToJSON Word where

285 toJSON = Number . fromIntegral

342 toJSON = Number . fromIntegral

286 {-# INLINE toJSON #-}

343 {-# INLINE toJSON #-}

287

344

345+ toEncoding = B.wordDec

346+

288instance FromJSON Word where

347instance FromJSON Word where

289 parseJSON = parseIntegral "Word"

348 parseJSON = parseIntegral "Word"

290 {-# INLINE parseJSON #-}

349 {-# INLINE parseJSON #-}

@@ -293,6 +352,8 @@ instance ToJSON Word8 where

293 toJSON = Number . fromIntegral

352 toJSON = Number . fromIntegral

294 {-# INLINE toJSON #-}

353 {-# INLINE toJSON #-}

295

354

355+ toEncoding = B.word8Dec

356+

296instance FromJSON Word8 where

357instance FromJSON Word8 where

297 parseJSON = parseIntegral "Word8"

358 parseJSON = parseIntegral "Word8"

298 {-# INLINE parseJSON #-}

359 {-# INLINE parseJSON #-}

@@ -301,6 +362,8 @@ instance ToJSON Word16 where

301 toJSON = Number . fromIntegral

362 toJSON = Number . fromIntegral

302 {-# INLINE toJSON #-}

363 {-# INLINE toJSON #-}

303

364

365+ toEncoding = B.word16Dec

366+

304instance FromJSON Word16 where

367instance FromJSON Word16 where

305 parseJSON = parseIntegral "Word16"

368 parseJSON = parseIntegral "Word16"

306 {-# INLINE parseJSON #-}

369 {-# INLINE parseJSON #-}

@@ -309,6 +372,8 @@ instance ToJSON Word32 where

309 toJSON = Number . fromIntegral

372 toJSON = Number . fromIntegral

310 {-# INLINE toJSON #-}

373 {-# INLINE toJSON #-}

311

374

375+ toEncoding = B.word32Dec

376+

312instance FromJSON Word32 where

377instance FromJSON Word32 where

313 parseJSON = parseIntegral "Word32"

378 parseJSON = parseIntegral "Word32"

314 {-# INLINE parseJSON #-}

379 {-# INLINE parseJSON #-}

@@ -317,6 +382,8 @@ instance ToJSON Word64 where

317 toJSON = Number . fromIntegral

382 toJSON = Number . fromIntegral

318 {-# INLINE toJSON #-}

383 {-# INLINE toJSON #-}

319

384

385+ toEncoding = B.word64Dec

386+

320instance FromJSON Word64 where

387instance FromJSON Word64 where

321 parseJSON = parseIntegral "Word64"

388 parseJSON = parseIntegral "Word64"

322 {-# INLINE parseJSON #-}

389 {-# INLINE parseJSON #-}

@@ -325,6 +392,8 @@ instance ToJSON Text where

325 toJSON = String

392 toJSON = String

326 {-# INLINE toJSON #-}

393 {-# INLINE toJSON #-}

327

394

395+ toEncoding = E.text

396+

328instance FromJSON Text where

397instance FromJSON Text where

329 parseJSON = withText "Text" pure

398 parseJSON = withText "Text" pure

330 {-# INLINE parseJSON #-}

399 {-# INLINE parseJSON #-}

@@ -333,6 +402,11 @@ instance ToJSON LT.Text where

333 toJSON = String . LT.toStrict

402 toJSON = String . LT.toStrict

334 {-# INLINE toJSON #-}

403 {-# INLINE toJSON #-}

335

404

405+ toEncoding t =

406+ B.char7 '"' <>

407+ LT.foldrChunks (\x xs -> E.unquoted x <> xs) mempty t <>

408+ B.char7 '"'

409+

336instance FromJSON LT.Text where

410instance FromJSON LT.Text where

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

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

338 {-# INLINE parseJSON #-}

412 {-# INLINE parseJSON #-}

@@ -341,14 +415,20 @@ instance (ToJSON a) => ToJSON [a] where

341 toJSON = Array . V.fromList . map toJSON

415 toJSON = Array . V.fromList . map toJSON

342 {-# INLINE toJSON #-}

416 {-# INLINE toJSON #-}

343

417

418+ toEncoding [] = E.emptyArray_

419+ toEncoding (x:xs) = B.char7 '[' <> toEncoding x <> commas xs <> B.char7 ']'

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

421+

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

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

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

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

346 {-# INLINE parseJSON #-}

424 {-# INLINE parseJSON #-}

347

425

348−instance (ToJSON a) => ToJSON (Seq.Seq a) where

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

349 toJSON = toJSON . toList

427 toJSON = toJSON . toList

350 {-# INLINE toJSON #-}

428 {-# INLINE toJSON #-}

351

429

430+ toEncoding = E.foldable

431+

352instance (FromJSON a) => FromJSON (Seq.Seq a) where

432instance (FromJSON a) => FromJSON (Seq.Seq a) where

353 parseJSON = withArray "Seq a" $ traverse parseJSON . Seq.fromList . V.toList

433 parseJSON = withArray "Seq a" $ traverse parseJSON . Seq.fromList . V.toList

354 {-# INLINE parseJSON #-}

434 {-# INLINE parseJSON #-}

@@ -357,6 +437,16 @@ instance (ToJSON a) => ToJSON (Vector a) where

357 toJSON = Array . V.map toJSON

437 toJSON = Array . V.map toJSON

358 {-# INLINE toJSON #-}

438 {-# INLINE toJSON #-}

359

439

440+ toEncoding = encodeVector

441+

442+encodeVector :: (ToJSON a, VG.Vector v a) => v a -> B.Builder

443+encodeVector xs

444+ | VG.null xs = E.emptyArray_

445+ | otherwise = B.char7 '[' <> toEncoding (VG.unsafeHead xs) <>

446+ VG.foldr go mempty (VG.unsafeTail xs) <>

447+ B.char7 ']'

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

449+

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

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

361 parseJSON = withArray "Vector a" $ V.mapM parseJSON

451 parseJSON = withArray "Vector a" $ V.mapM parseJSON

362 {-# INLINE parseJSON #-}

452 {-# INLINE parseJSON #-}

@@ -372,18 +462,24 @@ vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON

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

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

373 toJSON = vectorToJSON

463 toJSON = vectorToJSON

374

464

465+ toEncoding = encodeVector

466+

375instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where

467instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where

376 parseJSON = vectorParseJSON "Data.Vector.Storable.Vector a"

468 parseJSON = vectorParseJSON "Data.Vector.Storable.Vector a"

377

469

378instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where

470instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where

379 toJSON = vectorToJSON

471 toJSON = vectorToJSON

380

472

473+ toEncoding = encodeVector

474+

381instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where

475instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where

382 parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector a"

476 parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector a"

383

477

384instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where

478instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where

385 toJSON = vectorToJSON

479 toJSON = vectorToJSON

386

480

481+ toEncoding = encodeVector

482+

387instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where

483instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where

388 parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"

484 parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector a"

389

485

@@ -391,6 +487,8 @@ instance (ToJSON a) => ToJSON (Set.Set a) where

391 toJSON = toJSON . Set.toList

487 toJSON = toJSON . Set.toList

392 {-# INLINE toJSON #-}

488 {-# INLINE toJSON #-}

393

489

490+ toEncoding = encodeSet Set.minView Set.foldr

491+

394instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where

492instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where

395 parseJSON = fmap Set.fromList . parseJSON

493 parseJSON = fmap Set.fromList . parseJSON

396 {-# INLINE parseJSON #-}

494 {-# INLINE parseJSON #-}

@@ -399,6 +497,8 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where

399 toJSON = toJSON . HashSet.toList

497 toJSON = toJSON . HashSet.toList

400 {-# INLINE toJSON #-}

498 {-# INLINE toJSON #-}

401

499

500+ toEncoding = E.foldable

501+

402instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where

502instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where

403 parseJSON = fmap HashSet.fromList . parseJSON

503 parseJSON = fmap HashSet.fromList . parseJSON

404 {-# INLINE parseJSON #-}

504 {-# INLINE parseJSON #-}

@@ -407,6 +507,20 @@ instance ToJSON IntSet.IntSet where

407 toJSON = toJSON . IntSet.toList

507 toJSON = toJSON . IntSet.toList

408 {-# INLINE toJSON #-}

508 {-# INLINE toJSON #-}

409

509

510+ toEncoding = encodeSet IntSet.minView IntSet.foldr

511+

512+encodeSet :: (ToJSON a) =>

513+ (s -> Maybe (a, s))

514+ -> ((a -> B.Builder -> B.Builder) -> B.Builder -> s -> B.Builder)

515+ -> s -> B.Builder

516+encodeSet minView foldr xs =

517+ case minView xs of

518+ Nothing -> E.emptyArray_

519+ Just (m,ys) -> B.char7 '[' <> toEncoding m <>

520+ foldr go mempty ys <>

521+ B.char7 ']'

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

523+

410instance FromJSON IntSet.IntSet where

524instance FromJSON IntSet.IntSet where

411 parseJSON = fmap IntSet.fromList . parseJSON

525 parseJSON = fmap IntSet.fromList . parseJSON

412 {-# INLINE parseJSON #-}

526 {-# INLINE parseJSON #-}

@@ -415,6 +529,8 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where

415 toJSON = toJSON . IntMap.toList

529 toJSON = toJSON . IntMap.toList

416 {-# INLINE toJSON #-}

530 {-# INLINE toJSON #-}

417

531

532+ toEncoding = toEncoding . IntMap.toList

533+

418instance FromJSON a => FromJSON (IntMap.IntMap a) where

534instance FromJSON a => FromJSON (IntMap.IntMap a) where

419 parseJSON = fmap IntMap.fromList . parseJSON

535 parseJSON = fmap IntMap.fromList . parseJSON

420 {-# INLINE parseJSON #-}

536 {-# INLINE parseJSON #-}

@@ -423,6 +539,28 @@ instance (ToJSON v) => ToJSON (M.Map Text v) where

423 toJSON = Object . M.foldrWithKey (\k -> H.insert k . toJSON) H.empty

539 toJSON = Object . M.foldrWithKey (\k -> H.insert k . toJSON) H.empty

424 {-# INLINE toJSON #-}

540 {-# INLINE toJSON #-}

425

541

542+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey

543+

544+encodeMap :: (ToJSON k, ToJSON v) =>

545+ (m -> Maybe ((k,v), m))

546+ -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)

547+ -> m -> B.Builder

548+encodeMap minViewWithKey foldrWithKey xs =

549+ case minViewWithKey xs of

550+ Nothing -> BP.primBounded (E.ascii2 ('{','}')) ()

551+ Just ((k,v),ys) -> B.char7 '{' <> encodePair k v <>

552+ foldrWithKey go mempty ys <> B.char7 '}'

553+ where go k v b = B.char7 ',' <> encodePair k v <> b

554+

555+encodeWithKey :: (ToJSON k, ToJSON v) =>

556+ ((k -> v -> Series -> Series) -> Series -> m -> Series)

557+ -> m -> B.Builder

558+encodeWithKey foldrWithKey xs = E.series '{' '}' . foldrWithKey go mempty $ xs

559+ where go k v c = Value (encodePair k v) <> c

560+

561+encodePair :: (ToJSON k, ToJSON v) => k -> v -> B.Builder

562+encodePair k v = toEncoding k <> B.char7 ':' <> toEncoding v

563+

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

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

427 parseJSON = withObject "Map Text a" $

565 parseJSON = withObject "Map Text a" $

428 fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON

566 fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON

@@ -430,12 +568,16 @@ instance (FromJSON v) => FromJSON (M.Map Text v) where

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

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

431 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

569 toJSON = Object . mapHashKeyVal LT.toStrict toJSON

432

570

571+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey

572+

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

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

434 parseJSON = fmap (hashMapKey LT.fromStrict) . parseJSON

574 parseJSON = fmap (hashMapKey LT.fromStrict) . parseJSON

435

575

436instance (ToJSON v) => ToJSON (M.Map String v) where

576instance (ToJSON v) => ToJSON (M.Map String v) where

437 toJSON = Object . mapHashKeyVal pack toJSON

577 toJSON = Object . mapHashKeyVal pack toJSON

438

578

579+ toEncoding = encodeMap M.minViewWithKey M.foldrWithKey

580+

439instance (FromJSON v) => FromJSON (M.Map String v) where

581instance (FromJSON v) => FromJSON (M.Map String v) where

440 parseJSON = fmap (hashMapKey unpack) . parseJSON

582 parseJSON = fmap (hashMapKey unpack) . parseJSON

441

583

@@ -443,24 +585,32 @@ instance (ToJSON v) => ToJSON (H.HashMap Text v) where

443 toJSON = Object . H.map toJSON

585 toJSON = Object . H.map toJSON

444 {-# INLINE toJSON #-}

586 {-# INLINE toJSON #-}

445

587

588+ toEncoding = encodeWithKey H.foldrWithKey

589+

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

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

447 parseJSON = withObject "HashMap Text a" $ traverse parseJSON

591 parseJSON = withObject "HashMap Text a" $ traverse parseJSON

448

592

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

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

450 toJSON = Object . mapKeyVal LT.toStrict toJSON

594 toJSON = Object . mapKeyVal LT.toStrict toJSON

451

595

596+ toEncoding = encodeWithKey H.foldrWithKey

597+

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

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

453 parseJSON = fmap (mapKey LT.fromStrict) . parseJSON

599 parseJSON = fmap (mapKey LT.fromStrict) . parseJSON

454

600

455instance (ToJSON v) => ToJSON (H.HashMap String v) where

601instance (ToJSON v) => ToJSON (H.HashMap String v) where

456 toJSON = Object . mapKeyVal pack toJSON

602 toJSON = Object . mapKeyVal pack toJSON

457

603

604+ toEncoding = encodeWithKey H.foldrWithKey

605+

458instance (FromJSON v) => FromJSON (H.HashMap String v) where

606instance (FromJSON v) => FromJSON (H.HashMap String v) where

459 parseJSON = fmap (mapKey unpack) . parseJSON

607 parseJSON = fmap (mapKey unpack) . parseJSON

460

608

461instance (ToJSON v) => ToJSON (Tree.Tree v) where

609instance (ToJSON v) => ToJSON (Tree.Tree v) where

462 toJSON (Tree.Node root branches) = toJSON (root,branches)

610 toJSON (Tree.Node root branches) = toJSON (root,branches)

463

611

612+ toEncoding (Tree.Node root branches) = toEncoding (root,branches)

613+

464instance (FromJSON v) => FromJSON (Tree.Tree v) where

614instance (FromJSON v) => FromJSON (Tree.Tree v) where

465 parseJSON j = uncurry Tree.Node <$> parseJSON j

615 parseJSON j = uncurry Tree.Node <$> parseJSON j

466

616

@@ -468,16 +618,22 @@ instance ToJSON Value where

468 toJSON a = a

618 toJSON a = a

469 {-# INLINE toJSON #-}

619 {-# INLINE toJSON #-}

470

620

621+ toEncoding = E.encodeToBuilder

622+

471instance FromJSON Value where

623instance FromJSON Value where

472 parseJSON a = pure a

624 parseJSON a = pure a

473 {-# INLINE parseJSON #-}

625 {-# INLINE parseJSON #-}

474

626

475instance ToJSON DotNetTime where

627instance ToJSON DotNetTime where

476− toJSON (DotNetTime t) =

628+ toJSON = toJSON . dotNetTime

477− String (pack (secs ++ formatMillis t ++ ")/"))

478− where secs = formatTime defaultTimeLocale "/Date(%s" t

479 {-# INLINE toJSON #-}

629 {-# INLINE toJSON #-}

480

630

631+ toEncoding = toEncoding . dotNetTime

632+

633+dotNetTime :: DotNetTime -> String

634+dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"

635+ where secs = formatTime defaultTimeLocale "/Date(%s" t

636+

481instance FromJSON DotNetTime where

637instance FromJSON DotNetTime where

482 parseJSON = withText "DotNetTime" $ \t ->

638 parseJSON = withText "DotNetTime" $ \t ->

483 let (s,m) = T.splitAt (T.length t - 5) t

639 let (s,m) = T.splitAt (T.length t - 5) t

@@ -488,12 +644,16 @@ instance FromJSON DotNetTime where

488 {-# INLINE parseJSON #-}

644 {-# INLINE parseJSON #-}

489

645

490instance ToJSON ZonedTime where

646instance ToJSON ZonedTime where

647+ toJSON = toJSON . zonedTime

648+

649+ toEncoding = toEncoding . zonedTime

650+

651+zonedTime :: ZonedTime -> String

491− toJSON t = String $ pack $ formatTime defaultTimeLocale format t

652+zonedTime t = formatTime defaultTimeLocale format t

492− where

653+ where

493− format = "%FT%T." ++ formatMillis t ++ tzFormat

654+ format = "%FT%T." ++ formatMillis t ++ tzFormat

494− tzFormat

495− | 0 == timeZoneMinutes (zonedTimeZone t) = "Z"

655+ tzFormat | timeZoneMinutes (zonedTimeZone t) == 0 = "Z"

496− | otherwise = "%z"

656+ | otherwise = "%z"

497

657

498formatMillis :: (FormatTime t) => t -> String

658formatMillis :: (FormatTime t) => t -> String

499formatMillis = take 3 . formatSubseconds

659formatMillis = take 3 . formatSubseconds

@@ -535,11 +695,15 @@ instance FromJSON ZonedTime where

535 parseJSON v = typeMismatch "ZonedTime" v

695 parseJSON v = typeMismatch "ZonedTime" v

536

696

537instance ToJSON UTCTime where

697instance ToJSON UTCTime where

538− toJSON t = String $ pack $ formatTime defaultTimeLocale format t

698+ toJSON = toJSON . utcTime

539− where

540− format = "%FT%T." ++ formatSubseconds t ++ "Z"

541 {-# INLINE toJSON #-}

699 {-# INLINE toJSON #-}

542

700

701+ toEncoding = toEncoding . utcTime

702+

703+utcTime :: UTCTime -> String

704+utcTime t = formatTime defaultTimeLocale format t

705+ where format = "%FT%T." ++ formatSubseconds t ++ "Z"

706+

543instance FromJSON UTCTime where

707instance FromJSON UTCTime where

544 parseJSON = withText "UTCTime" $ \t ->

708 parseJSON = withText "UTCTime" $ \t ->

545 case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of

709 case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of

@@ -555,6 +719,10 @@ instance (ToJSON a, ToJSON b) => ToJSON (a,b) where

555 return mv

719 return mv

556 {-# INLINE toJSON #-}

720 {-# INLINE toJSON #-}

557

721

722+ toEncoding (a,b) = B.char7 '[' <>

723+ toEncoding a <> B.char7 ',' <>

724+ toEncoding b <> B.char7 ']'

725+

558instance (FromJSON a, FromJSON b) => FromJSON (a,b) where

726instance (FromJSON a, FromJSON b) => FromJSON (a,b) where

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

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

560 let n = V.length ab

728 let n = V.length ab

@@ -574,6 +742,11 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where

574 return mv

742 return mv

575 {-# INLINE toJSON #-}

743 {-# INLINE toJSON #-}

576

744

745+ toEncoding (a,b,c) = B.char7 '[' <>

746+ toEncoding a <> B.char7 ',' <>

747+ toEncoding b <> B.char7 ',' <>

748+ toEncoding c <> B.char7 ']'

749+

577instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where

750instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where

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

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

579 let n = V.length abc

752 let n = V.length abc

@@ -595,6 +768,12 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where

595 return mv

768 return mv

596 {-# INLINE toJSON #-}

769 {-# INLINE toJSON #-}

597

770

771+ toEncoding (a,b,c,d) = B.char7 '[' <>

772+ toEncoding a <> B.char7 ',' <>

773+ toEncoding b <> B.char7 ',' <>

774+ toEncoding c <> B.char7 ',' <>

775+ toEncoding d <> B.char7 ']'

776+

598instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>

777instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) =>

599 FromJSON (a,b,c,d) where

778 FromJSON (a,b,c,d) where

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

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

@@ -620,6 +799,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) =>

620 return mv

799 return mv

621 {-# INLINE toJSON #-}

800 {-# INLINE toJSON #-}

622

801

802+ toEncoding (a,b,c,d,e) = B.char7 '[' <>

803+ toEncoding a <> B.char7 ',' <>

804+ toEncoding b <> B.char7 ',' <>

805+ toEncoding c <> B.char7 ',' <>

806+ toEncoding d <> B.char7 ',' <>

807+ toEncoding e <> B.char7 ']'

808+

623instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>

809instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) =>

624 FromJSON (a,b,c,d,e) where

810 FromJSON (a,b,c,d,e) where

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

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

@@ -647,6 +833,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) =>

647 return mv

833 return mv

648 {-# INLINE toJSON #-}

834 {-# INLINE toJSON #-}

649

835

836+ toEncoding (a,b,c,d,e,f) = B.char7 '[' <>

837+ toEncoding a <> B.char7 ',' <>

838+ toEncoding b <> B.char7 ',' <>

839+ toEncoding c <> B.char7 ',' <>

840+ toEncoding d <> B.char7 ',' <>

841+ toEncoding e <> B.char7 ',' <>

842+ toEncoding f <> B.char7 ']'

843+

650instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

844instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

651 FromJSON f) => FromJSON (a,b,c,d,e,f) where

845 FromJSON f) => FromJSON (a,b,c,d,e,f) where

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

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

@@ -676,6 +870,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

676 return mv

870 return mv

677 {-# INLINE toJSON #-}

871 {-# INLINE toJSON #-}

678

872

873+ toEncoding (a,b,c,d,e,f,g) = B.char7 '[' <>

874+ toEncoding a <> B.char7 ',' <>

875+ toEncoding b <> B.char7 ',' <>

876+ toEncoding c <> B.char7 ',' <>

877+ toEncoding d <> B.char7 ',' <>

878+ toEncoding e <> B.char7 ',' <>

879+ toEncoding f <> B.char7 ',' <>

880+ toEncoding g <> B.char7 ']'

881+

679instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

882instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

680 FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where

883 FromJSON f, FromJSON g) => FromJSON (a,b,c,d,e,f,g) where

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

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

@@ -707,6 +910,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

707 return mv

910 return mv

708 {-# INLINE toJSON #-}

911 {-# INLINE toJSON #-}

709

912

913+ toEncoding (a,b,c,d,e,f,g,h) = B.char7 '[' <>

914+ toEncoding a <> B.char7 ',' <>

915+ toEncoding b <> B.char7 ',' <>

916+ toEncoding c <> B.char7 ',' <>

917+ toEncoding d <> B.char7 ',' <>

918+ toEncoding e <> B.char7 ',' <>

919+ toEncoding f <> B.char7 ',' <>

920+ toEncoding g <> B.char7 ',' <>

921+ toEncoding h <> B.char7 ']'

922+

710instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

923instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

711 FromJSON f, FromJSON g, FromJSON h) =>

924 FromJSON f, FromJSON g, FromJSON h) =>

712 FromJSON (a,b,c,d,e,f,g,h) where

925 FromJSON (a,b,c,d,e,f,g,h) where

@@ -742,6 +955,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

742 return mv

955 return mv

743 {-# INLINE toJSON #-}

956 {-# INLINE toJSON #-}

744

957

958+ toEncoding (a,b,c,d,e,f,g,h,i) = B.char7 '[' <>

959+ toEncoding a <> B.char7 ',' <>

960+ toEncoding b <> B.char7 ',' <>

961+ toEncoding c <> B.char7 ',' <>

962+ toEncoding d <> B.char7 ',' <>

963+ toEncoding e <> B.char7 ',' <>

964+ toEncoding f <> B.char7 ',' <>

965+ toEncoding g <> B.char7 ',' <>

966+ toEncoding h <> B.char7 ',' <>

967+ toEncoding i <> B.char7 ']'

968+

745instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

969instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

746 FromJSON f, FromJSON g, FromJSON h, FromJSON i) =>

970 FromJSON f, FromJSON g, FromJSON h, FromJSON i) =>

747 FromJSON (a,b,c,d,e,f,g,h,i) where

971 FromJSON (a,b,c,d,e,f,g,h,i) where

@@ -780,6 +1004,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

780 return mv

1004 return mv

781 {-# INLINE toJSON #-}

1005 {-# INLINE toJSON #-}

782

1006

1007+ toEncoding (a,b,c,d,e,f,g,h,i,j) = B.char7 '[' <>

1008+ toEncoding a <> B.char7 ',' <>

1009+ toEncoding b <> B.char7 ',' <>

1010+ toEncoding c <> B.char7 ',' <>

1011+ toEncoding d <> B.char7 ',' <>

1012+ toEncoding e <> B.char7 ',' <>

1013+ toEncoding f <> B.char7 ',' <>

1014+ toEncoding g <> B.char7 ',' <>

1015+ toEncoding h <> B.char7 ',' <>

1016+ toEncoding i <> B.char7 ',' <>

1017+ toEncoding j <> B.char7 ']'

1018+

783instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1019instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

784 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) =>

1020 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) =>

785 FromJSON (a,b,c,d,e,f,g,h,i,j) where

1021 FromJSON (a,b,c,d,e,f,g,h,i,j) where

@@ -820,6 +1056,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

820 return mv

1056 return mv

821 {-# INLINE toJSON #-}

1057 {-# INLINE toJSON #-}

822

1058

1059+ toEncoding (a,b,c,d,e,f,g,h,i,j,k) = B.char7 '[' <>

1060+ toEncoding a <> B.char7 ',' <>

1061+ toEncoding b <> B.char7 ',' <>

1062+ toEncoding c <> B.char7 ',' <>

1063+ toEncoding d <> B.char7 ',' <>

1064+ toEncoding e <> B.char7 ',' <>

1065+ toEncoding f <> B.char7 ',' <>

1066+ toEncoding g <> B.char7 ',' <>

1067+ toEncoding h <> B.char7 ',' <>

1068+ toEncoding i <> B.char7 ',' <>

1069+ toEncoding j <> B.char7 ',' <>

1070+ toEncoding k <> B.char7 ']'

1071+

823instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1072instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

824 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1073 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

825 FromJSON k) =>

1074 FromJSON k) =>

@@ -863,6 +1112,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

863 return mv

1112 return mv

864 {-# INLINE toJSON #-}

1113 {-# INLINE toJSON #-}

865

1114

1115+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l) = B.char7 '[' <>

1116+ toEncoding a <> B.char7 ',' <>

1117+ toEncoding b <> B.char7 ',' <>

1118+ toEncoding c <> B.char7 ',' <>

1119+ toEncoding d <> B.char7 ',' <>

1120+ toEncoding e <> B.char7 ',' <>

1121+ toEncoding f <> B.char7 ',' <>

1122+ toEncoding g <> B.char7 ',' <>

1123+ toEncoding h <> B.char7 ',' <>

1124+ toEncoding i <> B.char7 ',' <>

1125+ toEncoding j <> B.char7 ',' <>

1126+ toEncoding k <> B.char7 ',' <>

1127+ toEncoding l <> B.char7 ']'

1128+

866instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1129instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

867 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1130 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

868 FromJSON k, FromJSON l) =>

1131 FromJSON k, FromJSON l) =>

@@ -909,6 +1172,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

909 return mv

1172 return mv

910 {-# INLINE toJSON #-}

1173 {-# INLINE toJSON #-}

911

1174

1175+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m) = B.char7 '[' <>

1176+ toEncoding a <> B.char7 ',' <>

1177+ toEncoding b <> B.char7 ',' <>

1178+ toEncoding c <> B.char7 ',' <>

1179+ toEncoding d <> B.char7 ',' <>

1180+ toEncoding e <> B.char7 ',' <>

1181+ toEncoding f <> B.char7 ',' <>

1182+ toEncoding g <> B.char7 ',' <>

1183+ toEncoding h <> B.char7 ',' <>

1184+ toEncoding i <> B.char7 ',' <>

1185+ toEncoding j <> B.char7 ',' <>

1186+ toEncoding k <> B.char7 ',' <>

1187+ toEncoding l <> B.char7 ',' <>

1188+ toEncoding m <> B.char7 ']'

1189+

912instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1190instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

913 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1191 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

914 FromJSON k, FromJSON l, FromJSON m) =>

1192 FromJSON k, FromJSON l, FromJSON m) =>

@@ -957,6 +1235,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

957 return mv

1235 return mv

958 {-# INLINE toJSON #-}

1236 {-# INLINE toJSON #-}

959

1237

1238+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = B.char7 '[' <>

1239+ toEncoding a <> B.char7 ',' <>

1240+ toEncoding b <> B.char7 ',' <>

1241+ toEncoding c <> B.char7 ',' <>

1242+ toEncoding d <> B.char7 ',' <>

1243+ toEncoding e <> B.char7 ',' <>

1244+ toEncoding f <> B.char7 ',' <>

1245+ toEncoding g <> B.char7 ',' <>

1246+ toEncoding h <> B.char7 ',' <>

1247+ toEncoding i <> B.char7 ',' <>

1248+ toEncoding j <> B.char7 ',' <>

1249+ toEncoding k <> B.char7 ',' <>

1250+ toEncoding l <> B.char7 ',' <>

1251+ toEncoding m <> B.char7 ',' <>

1252+ toEncoding n <> B.char7 ']'

1253+

960instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1254instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

961 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1255 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

962 FromJSON k, FromJSON l, FromJSON m, FromJSON n) =>

1256 FromJSON k, FromJSON l, FromJSON m, FromJSON n) =>

@@ -1007,6 +1301,23 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f,

1007 return mv

1301 return mv

1008 {-# INLINE toJSON #-}

1302 {-# INLINE toJSON #-}

1009

1303

1304+ toEncoding (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = B.char7 '[' <>

1305+ toEncoding a <> B.char7 ',' <>

1306+ toEncoding b <> B.char7 ',' <>

1307+ toEncoding c <> B.char7 ',' <>

1308+ toEncoding d <> B.char7 ',' <>

1309+ toEncoding e <> B.char7 ',' <>

1310+ toEncoding f <> B.char7 ',' <>

1311+ toEncoding g <> B.char7 ',' <>

1312+ toEncoding h <> B.char7 ',' <>

1313+ toEncoding i <> B.char7 ',' <>

1314+ toEncoding j <> B.char7 ',' <>

1315+ toEncoding k <> B.char7 ',' <>

1316+ toEncoding l <> B.char7 ',' <>

1317+ toEncoding m <> B.char7 ',' <>

1318+ toEncoding n <> B.char7 ',' <>

1319+ toEncoding o <> B.char7 ']'

1320+

1010instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1321instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,

1011 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1322 FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j,

1012 FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) =>

1323 FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) =>

@@ -1038,6 +1349,8 @@ instance ToJSON a => ToJSON (Dual a) where

1038 toJSON = toJSON . getDual

1349 toJSON = toJSON . getDual

1039 {-# INLINE toJSON #-}

1350 {-# INLINE toJSON #-}

1040

1351

1352+ toEncoding = toEncoding . getDual

1353+

1041instance FromJSON a => FromJSON (Dual a) where

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

1042 parseJSON = fmap Dual . parseJSON

1355 parseJSON = fmap Dual . parseJSON

1043 {-# INLINE parseJSON #-}

1356 {-# INLINE parseJSON #-}

@@ -1046,6 +1359,8 @@ instance ToJSON a => ToJSON (First a) where

1046 toJSON = toJSON . getFirst

1359 toJSON = toJSON . getFirst

1047 {-# INLINE toJSON #-}

1360 {-# INLINE toJSON #-}

1048

1361

1362+ toEncoding = toEncoding . getFirst

1363+

1049instance FromJSON a => FromJSON (First a) where

1364instance FromJSON a => FromJSON (First a) where

1050 parseJSON = fmap First . parseJSON

1365 parseJSON = fmap First . parseJSON

1051 {-# INLINE parseJSON #-}

1366 {-# INLINE parseJSON #-}

@@ -1054,6 +1369,8 @@ instance ToJSON a => ToJSON (Last a) where

1054 toJSON = toJSON . getLast

1369 toJSON = toJSON . getLast

1055 {-# INLINE toJSON #-}

1370 {-# INLINE toJSON #-}

1056

1371

1372+ toEncoding = toEncoding . getLast

1373+

1057instance FromJSON a => FromJSON (Last a) where

1374instance FromJSON a => FromJSON (Last a) where

1058 parseJSON = fmap Last . parseJSON

1375 parseJSON = fmap Last . parseJSON

1059 {-# INLINE parseJSON #-}

1376 {-# INLINE parseJSON #-}

@@ -1176,6 +1493,12 @@ realFloatToJSON d

1176 | otherwise = Number $ Scientific.fromFloatDigits d

1493 | otherwise = Number $ Scientific.fromFloatDigits d

1177{-# INLINE realFloatToJSON #-}

1494{-# INLINE realFloatToJSON #-}

1178

1495

1496+realFloatToEncoding :: RealFloat a => a -> Encoding

1497+realFloatToEncoding d

1498+ | isNaN d || isInfinite d = E.null_

1499+ | otherwise = toEncoding (Scientific.fromFloatDigits d)

1500+{-# INLINE realFloatToEncoding #-}

1501+

1179scientificToNumber :: Scientific -> Number

1502scientificToNumber :: Scientific -> Number

1180scientificToNumber s

1503scientificToNumber s

1181 | e < 0 = D $ Scientific.toRealFloat s

1504 | e < 0 = D $ Scientific.toRealFloat s

Data/Aeson/Types/Internal.hs+20−2

@@ -15,6 +15,8 @@ module Data.Aeson.Types.Internal

15 (

16 -- * Core JSON types

17 Value(..)

18+ , Encoding

19+ , Series(..)

18 , Array

20 , Array

19 , emptyArray, isEmptyArray

21 , emptyArray, isEmptyArray

20 , Pair

22 , Pair

@@ -43,16 +45,16 @@ module Data.Aeson.Types.Internal

43 , DotNetTime(..)

45 , DotNetTime(..)

44 ) where

46 ) where

46−

47import Control.Applicative

48import Control.Applicative

48import Control.Monad

49import Control.Monad

49import Control.DeepSeq (NFData(..))

50import Control.DeepSeq (NFData(..))

51+import Data.ByteString.Builder (Builder, char7)

50import Data.Char (toLower, isUpper)

52import Data.Char (toLower, isUpper)

51import Data.Scientific (Scientific)

53import Data.Scientific (Scientific)

52import Data.Hashable (Hashable(..))

54import Data.Hashable (Hashable(..))

53import Data.Data (Data)

55import Data.Data (Data)

54import Data.HashMap.Strict (HashMap)

56import Data.HashMap.Strict (HashMap)

55−import Data.Monoid (Monoid(..))

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

56import Data.String (IsString(..))

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

57import Data.Text (Text, pack)

59import Data.Text (Text, pack)

58import Data.Time (UTCTime)

60import Data.Time (UTCTime)

@@ -182,6 +184,22 @@ data Value = Object !Object

182 | Null

184 | Null

183 deriving (Eq, Read, Show, Typeable, Data)

185 deriving (Eq, Read, Show, Typeable, Data)

184

186

187+-- | An encoding of a JSON value.

188+type Encoding = Builder

189+

190+data Series = Empty

191+ | Value Builder

192+ deriving (Typeable)

193+

194+instance Monoid Series where

195+ mempty = Empty

196+ mappend Empty a = a

197+ mappend (Value a) b =

198+ Value $

199+ a <> case b of

200+ Empty -> mempty

201+ Value c -> char7 ',' <> c

202+

185-- | A newtype wrapper for 'UTCTime' that uses the same non-standard

203-- | A newtype wrapper for 'UTCTime' that uses the same non-standard

186-- serialization format as Microsoft .NET, whose @System.DateTime@

204-- serialization format as Microsoft .NET, whose @System.DateTime@

187-- type is by default serialized to JSON as in the following example:

205-- type is by default serialized to JSON as in the following example: