@@ -24,14 +24,11 @@ module Data.Aeson.Types.Generic ( ) where
2424import Control.Applicative ((<|>))
2525import Control.Monad ((<=<))
2626import Control.Monad.ST (ST)
27−import Data.Aeson.Encoding (Encoding (..), emptyArray_)
28−import Data.Aeson.Encode.Functions (builder)
27+import Data.Aeson.Encoding (Encoding, (>*<))
28+import qualified Data.Aeson.Encoding as E
2929import Data.Aeson.Types.Instances
30−import Data.Aeson.Encoding ((>*<), tuple)
3130import Data.Aeson.Types.Internal
3231import Data.Bits (unsafeShiftR)
33−import Data.ByteString.Builder as B
34−import qualified Data.ByteString.Lazy as BSL (null)
3532import Data.DList (DList, toList, empty)
3633import Data.Maybe (fromMaybe)
3734import Data.Monoid ((<>))
@@ -102,28 +99,27 @@ instance (ToJSON a) => GToEncoding (K1 i a) where
10299
103100instance GToEncoding U1 where
104101 -- Empty constructors are encoded to an empty array:
105− gToEncoding _opts _ = emptyArray_
102+ gToEncoding _opts _ = E.emptyArray_
106103
107104instance (ConsToEncoding a) => GToEncoding (C1 c a) where
108105 -- Constructors need to be encoded differently depending on whether they're
109106 -- a record or not. This distinction is made by 'consToEncoding':
110− gToEncoding opts = Encoding . consToEncoding opts . unM1
107+ gToEncoding opts = consToEncoding opts . unM1
111108
112109instance ( EncodeProduct a, EncodeProduct b ) => GToEncoding (a :*: b) where
113110 -- Products are encoded to an array. Here we allocate a mutable vector of
114111 -- the same size as the product and write the product's elements to it using
115112 -- 'encodeProduct':
116− gToEncoding opts p = Encoding $
117− B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
113+ gToEncoding opts p = E.tuple $ encodeProduct opts p
118114
119115instance ( AllNullary (a :+: b) allNullary
120116 , SumToEncoding (a :+: b) allNullary ) => GToEncoding (a :+: b) where
121117 -- If all constructors of a sum datatype are nullary and the
122118 -- 'allNullaryToStringTag' option is set they are encoded to
123119 -- strings. This distinction is made by 'sumToEncoding':
124− gToEncoding opts = Encoding .
125− (unTagged :: Tagged allNullary B.Builder -> B.Builder) .
126− sumToEncoding opts
120+ gToEncoding opts
121+ = (unTagged :: Tagged allNullary Encoding -> Encoding)
122+ . sumToEncoding opts
127123
128124--------------------------------------------------------------------------------
129125
@@ -158,14 +154,14 @@ nonAllNullarySumToJSON opts =
158154--------------------------------------------------------------------------------
159155
160156class SumToEncoding f allNullary where
161− sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
157+ sumToEncoding :: Options -> f a -> Tagged allNullary Encoding
162158
163159instance ( GetConName f
164160 , TaggedObjectEnc f
165161 , ObjectWithSingleFieldEnc f
166162 , TwoElemArrayEnc f ) => SumToEncoding f True where
167163 sumToEncoding opts
168− | allNullaryToStringTag opts = Tagged . builder .
164+ | allNullaryToStringTag opts = Tagged . toEncoding .
169165 constructorTagModifier opts . getConName
170166 | otherwise = Tagged . nonAllNullarySumToEncoding opts
171167
@@ -177,7 +173,7 @@ instance ( TwoElemArrayEnc f
177173nonAllNullarySumToEncoding :: ( TwoElemArrayEnc f
178174 , TaggedObjectEnc f
179175 , ObjectWithSingleFieldEnc f
180− ) => Options -> f a -> B.Builder
176+ ) => Options -> f a -> Encoding
181177nonAllNullarySumToEncoding opts =
182178 case sumEncoding opts of
183179 TaggedObject{..} ->
@@ -222,7 +218,7 @@ instance (GToJSON f) => TaggedObjectPairs' f False where
222218--------------------------------------------------------------------------------
223219
224220class TaggedObjectEnc f where
225− taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
221+ taggedObjectEnc :: Options -> String -> String -> f a -> Encoding
226222
227223instance ( TaggedObjectEnc a
228224 , TaggedObjectEnc b ) => TaggedObjectEnc (a :+: b) where
@@ -235,27 +231,27 @@ instance ( IsRecord a isRecord
235231 , TaggedObjectEnc' a isRecord
236232 , Constructor c ) => TaggedObjectEnc (C1 c a) where
237233 taggedObjectEnc opts tagFieldName contentsFieldName v =
238− B.char7 '{' <>
239− (builder tagFieldName <>
240− B.char7 ':' <>
241− builder (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
242− ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .
234+ E.openCurly <>
235+ (toEncoding tagFieldName <>
236+ E.colon <>
237+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
238+ ((unTagged :: Tagged isRecord Encoding -> Encoding) .
243239 taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
244− B.char7 '}'
240+ E.closeCurly
245241
246242class TaggedObjectEnc' f isRecord where
247− taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder
243+ taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord Encoding
248244
249245instance OVERLAPPING_ TaggedObjectEnc' U1 False where
250246 taggedObjectEnc' _ _ _ = Tagged mempty
251247
252248instance (RecordToEncoding f) => TaggedObjectEnc' f True where
253− taggedObjectEnc' opts _ = Tagged . (B.char7 ',' <>) . fst . recordToEncoding opts
249+ taggedObjectEnc' opts _ = Tagged . (E.comma <>) . fst . recordToEncoding opts
254250
255251instance (GToEncoding f) => TaggedObjectEnc' f False where
256252 taggedObjectEnc' opts contentsFieldName =
257− Tagged . (\z -> B.char7 ',' <> builder contentsFieldName <> B.char7 ':' <> z) .
258− gbuilder opts
253+ Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .
254+ gToEncoding opts
259255
260256--------------------------------------------------------------------------------
261257
@@ -291,7 +287,7 @@ instance ( GToJSON a, ConsToJSON a
291287--------------------------------------------------------------------------------
292288
293289class TwoElemArrayEnc f where
294− twoElemArrayEnc :: Options -> f a -> B.Builder
290+ twoElemArrayEnc :: Options -> f a -> Encoding
295291
296292instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) where
297293 twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
@@ -299,7 +295,7 @@ instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) whe
299295
300296instance ( GToEncoding a, ConsToEncoding a
301297 , Constructor c ) => TwoElemArrayEnc (C1 c a) where
302− twoElemArrayEnc opts x = fromEncoding . tuple $
298+ twoElemArrayEnc opts x = E.tuple $
303299 toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
304300 gToEncoding opts x
305301
@@ -330,15 +326,15 @@ instance GToJSON f => ConsToJSON' f False where
330326--------------------------------------------------------------------------------
331327
332328class ConsToEncoding f where
333− consToEncoding :: Options -> f a -> B.Builder
329+ consToEncoding :: Options -> f a -> Encoding
334330
335331class ConsToEncoding' f isRecord where
336332 consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
337− -> f a -> Tagged isRecord B.Builder
333+ -> f a -> Tagged isRecord Encoding
338334
339335instance ( IsRecord f isRecord
340336 , ConsToEncoding' f isRecord ) => ConsToEncoding f where
341− consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
337+ consToEncoding opts = (unTagged :: Tagged isRecord Encoding -> Encoding)
342338 . consToEncoding' opts (isUnary (undefined :: f a))
343339
344340instance (RecordToEncoding f) => ConsToEncoding' f True where
@@ -346,10 +342,10 @@ instance (RecordToEncoding f) => ConsToEncoding' f True where
346342 let (enc, mbVal) = recordToEncoding opts x
347343 in case (unwrapUnaryRecords opts, isUn, mbVal) of
348344 (True, True, Just val) -> Tagged val
349− _ -> Tagged $ B.char7 '{' <> enc <> B.char7 '}'
345+ _ -> Tagged $ E.wrapObject enc
350346
351347instance GToEncoding f => ConsToEncoding' f False where
352− consToEncoding' opts _ = Tagged . gbuilder opts
348+ consToEncoding' opts _ = Tagged . gToEncoding opts
353349
354350--------------------------------------------------------------------------------
355351
@@ -380,16 +376,16 @@ class RecordToEncoding f where
380376 -- 1st element: whole thing
381377 -- 2nd element: in case the record has only 1 field, just the value
382378 -- of the field (without the key); 'Nothing' otherwise
383− recordToEncoding :: Options -> f a -> (B.Builder, Maybe B.Builder)
379+ recordToEncoding :: Options -> f a -> (Encoding, Maybe Encoding)
384380
385381instance (RecordToEncoding a, RecordToEncoding b) => RecordToEncoding (a :*: b) where
386382 recordToEncoding opts (a :*: b) | omitNothingFields opts =
387− (mconcat $ intersperse (B.char7 ',') $
388− filter (not . BSL.null . B.toLazyByteString)
383+ (mconcat $ intersperse E.comma $
384+ filter (not . E.nullEncoding)
389385 [fst (recordToEncoding opts a), fst (recordToEncoding opts b)]
390386 , Nothing)
391387 recordToEncoding opts (a :*: b) =
392− (fst (recordToEncoding opts a) <> B.char7 ',' <>
388+ (fst (recordToEncoding opts a) <> E.comma <>
393389 fst (recordToEncoding opts b),
394390 Nothing)
395391
@@ -402,11 +398,11 @@ instance OVERLAPPING_ (Selector s, ToJSON a) =>
402398 , K1 Nothing <- k1 = (mempty, Nothing)
403399 recordToEncoding opts m1 = fieldToEncoding opts m1
404400
405−fieldToEncoding :: (Selector s, GToEncoding a) => Options -> S1 s a p -> (B.Builder, Maybe B.Builder)
401+fieldToEncoding :: (Selector s, GToEncoding a) => Options -> S1 s a p -> (Encoding, Maybe Encoding)
406402fieldToEncoding opts m1 =
407− let keyBuilder = builder (fieldLabelModifier opts $ selName m1)
408− valueBuilder = gbuilder opts (unM1 m1)
409− in (keyBuilder <> B.char7 ':' <> valueBuilder, Just valueBuilder)
403+ let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
404+ valueBuilder = gToEncoding opts (unM1 m1)
405+ in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)
410406
411407--------------------------------------------------------------------------------
412408
@@ -434,20 +430,20 @@ instance OVERLAPPABLE_ (GToJSON a) => WriteProduct a where
434430--------------------------------------------------------------------------------
435431
436432class EncodeProduct f where
437− encodeProduct :: Options -> f a -> B.Builder
433+ encodeProduct :: Options -> f a -> Encoding
438434
439435instance ( EncodeProduct a
440436 , EncodeProduct b ) => EncodeProduct (a :*: b) where
441437 encodeProduct opts (a :*: b) | omitNothingFields opts =
442− mconcat $ intersperse (B.char7 ',') $
443− filter (not . BSL.null . B.toLazyByteString)
438+ mconcat $ intersperse E.comma $
439+ filter (not . E.nullEncoding)
444440 [encodeProduct opts a, encodeProduct opts b]
445441 encodeProduct opts (a :*: b) = encodeProduct opts a <>
446− B.char7 ',' <>
442+ E.comma <>
447443 encodeProduct opts b
448444
449445instance OVERLAPPABLE_ (GToEncoding a) => EncodeProduct a where
450− encodeProduct opts = gbuilder opts
446+ encodeProduct opts = gToEncoding opts
451447
452448--------------------------------------------------------------------------------
453449
@@ -469,7 +465,7 @@ instance ( GToJSON a, ConsToJSON a
469465--------------------------------------------------------------------------------
470466
471467class ObjectWithSingleFieldEnc f where
472− objectWithSingleFieldEnc :: Options -> f a -> B.Builder
468+ objectWithSingleFieldEnc :: Options -> f a -> Encoding
473469
474470instance ( ObjectWithSingleFieldEnc a
475471 , ObjectWithSingleFieldEnc b ) => ObjectWithSingleFieldEnc (a :+: b) where
@@ -479,15 +475,13 @@ instance ( ObjectWithSingleFieldEnc a
479475instance ( GToEncoding a, ConsToEncoding a
480476 , Constructor c ) => ObjectWithSingleFieldEnc (C1 c a) where
481477 objectWithSingleFieldEnc opts v =
482− B.char7 '{' <>
483− builder (constructorTagModifier opts
484− (conName (undefined :: t c a p))) <>
485− B.char7 ':' <>
486− gbuilder opts v <>
487− B.char7 '}'
488−
489−gbuilder :: GToEncoding f => Options -> f a -> Builder
490−gbuilder opts = fromEncoding . gToEncoding opts
478+ E.openCurly <>
479+ toEncoding
480+ (constructorTagModifier opts
481+ (conName (undefined :: t c a p))) <>
482+ E.colon <>
483+ gToEncoding opts v <>
484+ E.closeCurly
491485
492486--------------------------------------------------------------------------------
493487-- Generic parseJSON