c9dce67 · typeable/aeson

git.iko.soy/typeable/aeson

Tagged encoding

commitc9dce672066e829d5d94f2e2e05847b908bdac99 authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 8 Jun 2016, 15:41 (10 years ago) parent4097dc9

5 files changed+132−106

compare with master

unifiedsplit

Data/Aeson/Encoding.hs+6 Data/Aeson/Encoding/Internal.hs+82−57 Data/Aeson/TH.hs+4−5 Data/Aeson/Types/ToJSON.hs+40−43 tests/UnitTests.hs−1

Data/Aeson/Encoding.hs+6

@@ -1,7 +1,13 @@

1+-- |

2+--

3+-- Functions in this module return well-formed 'Encoding''.

4+-- Polymorphic variants, which return @'Encoding' a@, return a textual JSON

5+-- value, so it can be used as both @'Encoding'' 'Text'@ and @'Encoding' = 'Encoding'' 'Value'@.

16module Data.Aeson.Encoding

27 (

38 -- * Encoding

49 Encoding

10+ , Encoding'

511 , encodingToLazyByteString

612 , fromEncoding

713 , unsafeToEncoding

Data/Aeson/Encoding/Internal.hs+82−57

@@ -1,14 +1,16 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE OverloadedStrings #-}

4−{-# LANGUAGE RankNTypes #-}

1+{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE EmptyDataDecls #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE RankNTypes #-}

55module Data.Aeson.Encoding.Internal

66 (

77 -- * Encoding

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

9− , encodingToLazyByteString

8+ Encoding' (..)

9+ , Encoding

10+ , encodingToLazyByteString

1011 , unsafeToEncoding

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

12+ , retagEncoding

13+ , Series (..)

1214 , pairs

1315 , pair

1416 -- * Predicates

@@ -16,8 +18,8 @@ module Data.Aeson.Encoding.Internal

1618 -- * Encoding constructors

1719 , emptyArray_

1820 , emptyObject_

19− , wrapArray

2021 , wrapObject

22+ , wrapArray

2123 , null_

2224 , bool

2325 , text

@@ -27,6 +29,10 @@ module Data.Aeson.Encoding.Internal

2729 , dict

2830 , tuple

2931 , (>*<)

32+ , InArray

33+ , empty

34+ , (><)

35+ , econcat

3036 -- ** Decimal numbers

3137 , int8, int16, int32, int64, int

3238 , word8, word16, word32, word64, word

@@ -69,33 +75,42 @@ import qualified Data.ByteString.Lazy as BSL

6975import qualified Data.Text.Lazy as LT

7076

7177-- | An encoding of a JSON value.

72−newtype Encoding = Encoding {

78+--

79+-- @tag@ represents which kind of JSON the Encoding is encoding to,

80+-- we reuse 'Text' and 'Value' as tags here.

81+newtype Encoding' tag = Encoding {

7382 fromEncoding :: Builder

7483 -- ^ Acquire the underlying bytestring builder.

75− } deriving (Semigroup,Monoid,Typeable)

84+ } deriving (Typeable)

85+

86+-- | Often used synonnym for 'Encoding''.

87+type Encoding = Encoding' Value

7688

7789-- | Make Encoding from Builder.

7890--

7991-- Use with care! You have to make sure that the passed Builder

8092-- is a valid JSON Encoding!

81−unsafeToEncoding :: Builder -> Encoding

93+unsafeToEncoding :: Builder -> Encoding' a

8294unsafeToEncoding = Encoding

8395

84−encodingToLazyByteString :: Encoding -> BSL.ByteString

96+encodingToLazyByteString :: Encoding' a -> BSL.ByteString

8597encodingToLazyByteString = toLazyByteString . fromEncoding

8698{-# INLINE encodingToLazyByteString #-}

8799

100+retagEncoding :: Encoding' a -> Encoding' b

101+retagEncoding = Encoding . fromEncoding

102+

88103-------------------------------------------------------------------------------

89104-- Encoding instances

90105-------------------------------------------------------------------------------

91106

92−instance Show Encoding where

107+instance Show (Encoding' a) where

93108 show (Encoding e) = show (toLazyByteString e)

94109

95−instance Eq Encoding where

110+instance Eq (Encoding' a) where

96111 Encoding a == Encoding b = toLazyByteString a == toLazyByteString b

97112

98−instance Ord Encoding where

113+instance Ord (Encoding' a) where

99114 compare (Encoding a) (Encoding b) =

100115 compare (toLazyByteString a) (toLazyByteString b)

101116

@@ -107,25 +122,22 @@ instance Ord Encoding where

107122--

108123-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)

109124data Series = Empty

110− | Value Encoding

125+ | Value (Encoding' Series)

111126 deriving (Typeable)

112127

113128pair :: Text -> Encoding -> Series

114−pair name val = Value $ text name <> colon <> val

129+pair name val = Value $ retagEncoding $ text name >< colon >< val

115130

116131instance Semigroup Series where

117− Empty <> a = a

118− Value a <> b =

119− Value $

120− a <> case b of

121− Empty -> mempty

122− Value c -> Encoding (char7 ',') <> c

132+ Empty <> a = a

133+ a <> Empty = a

134+ Value a <> Value b = Value (a >< comma >< b)

123135

124136instance Monoid Series where

125137 mempty = Empty

126138 mappend = (<>)

127139

128−nullEncoding :: Encoding -> Bool

140+nullEncoding :: Encoding' a -> Bool

129141nullEncoding = BSL.null . toLazyByteString . fromEncoding

130142

131143emptyArray_ :: Encoding

@@ -134,11 +146,11 @@ emptyArray_ = Encoding EB.emptyArray_

134146emptyObject_ :: Encoding

135147emptyObject_ = Encoding EB.emptyObject_

136148

137−wrapArray :: Encoding -> Encoding

138−wrapArray e = openBracket <> e <> closeBracket

149+wrapArray :: Encoding' a -> Encoding

150+wrapArray e = retagEncoding $ openBracket >< e >< closeBracket

139151

140−wrapObject :: Encoding -> Encoding

141−wrapObject e = openCurly <> e <> closeCurly

152+wrapObject :: Encoding' a -> Encoding

153+wrapObject e = retagEncoding $ openCurly >< e >< closeCurly

142154

143155null_ :: Encoding

144156null_ = Encoding EB.null_

@@ -167,7 +179,7 @@ list to' (x:xs) = Encoding $

167179

168180-- | Encode as JSON object

169181dict

170− :: (k -> Encoding) -- ^ key encoding

182+ :: (k -> Encoding' Text) -- ^ key encoding

171183 -> (v -> Encoding) -- ^ value encoding

172184 -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold

173185 -> m -- ^ container

@@ -175,15 +187,29 @@ dict

175187dict encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty

176188 where

177189 go k v c = Value (encodeKV k v) <> c

178− encodeKV k v = encodeKey k <> Encoding (char7 ':') <> encodeVal v

190+ encodeKV k v = retagEncoding (encodeKey k) >< colon >< retagEncoding (encodeVal v)

179191{-# INLINE dict #-}

180192

193+-- | Type tag for tuples contents, see 'tuple'.

194+data InArray

195+

181196infixr 6 >*<

182197-- | See 'tuple'.

183−(>*<) :: Encoding -> Encoding -> Encoding

198+(>*<) :: Encoding' a -> Encoding' b -> Encoding' InArray

184199Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b

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

186201

202+empty :: Encoding' a

203+empty = Encoding mempty

204+

205+econcat :: [Encoding' a] -> Encoding' a

206+econcat = foldr (><) empty

207+

208+infixr 6 ><

209+(><) :: Encoding' a -> Encoding' a -> Encoding' a

210+Encoding a >< Encoding b = Encoding (a <> b)

211+{-# INLINE (><) #-}

212+

187213-- | Encode as a tuple.

188214--

189215-- @

@@ -191,26 +217,26 @@ Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b

191217-- toEncoding a >*<

192218-- toEncoding b >*<

193219-- toEncoding c

194−tuple :: Encoding -> Encoding

195−tuple b = Encoding (char7 '[' <> fromEncoding b <> char7 ']')

220+tuple :: Encoding' InArray -> Encoding

221+tuple b = retagEncoding $ openBracket >< b >< closeBracket

196222{-# INLINE tuple #-}

197223

198−text :: Text -> Encoding

224+text :: Text -> Encoding' a

199225text = Encoding . EB.text

200226

201−lazyText :: LT.Text -> Encoding

227+lazyText :: LT.Text -> Encoding' a

202228lazyText t = Encoding $

203229 B.char7 '"' <>

204230 LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t

205231

206−string :: String -> Encoding

232+string :: String -> Encoding' a

207233string = Encoding . EB.string

208234

209235-------------------------------------------------------------------------------

210236-- chars

211237-------------------------------------------------------------------------------

212238

213−comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding

239+comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding' a

214240comma = Encoding $ char7 ','

215241colon = Encoding $ char7 ':'

216242openBracket = Encoding $ char7 '['

@@ -274,66 +300,65 @@ realFloatToEncoding e d

274300-- Decimal numbers as Text

275301-------------------------------------------------------------------------------

276302

277−int8Text :: Int8 -> Encoding

303+int8Text :: Int8 -> Encoding' a

278304int8Text = Encoding . EB.quote . B.int8Dec

279305

280−int16Text :: Int16 -> Encoding

306+int16Text :: Int16 -> Encoding' a

281307int16Text = Encoding . EB.quote . B.int16Dec

282308

283−int32Text :: Int32 -> Encoding

309+int32Text :: Int32 -> Encoding' a

284310int32Text = Encoding . EB.quote . B.int32Dec

285311

286−int64Text :: Int64 -> Encoding

312+int64Text :: Int64 -> Encoding' a

287313int64Text = Encoding . EB.quote . B.int64Dec

288314

289−intText :: Int -> Encoding

315+intText :: Int -> Encoding' a

290316intText = Encoding . EB.quote . B.intDec

291317

292−word8Text :: Word8 -> Encoding

318+word8Text :: Word8 -> Encoding' a

293319word8Text = Encoding . EB.quote . B.word8Dec

294320

295−word16Text :: Word16 -> Encoding

321+word16Text :: Word16 -> Encoding' a

296322word16Text = Encoding . EB.quote . B.word16Dec

297323

298−word32Text :: Word32 -> Encoding

324+word32Text :: Word32 -> Encoding' a

299325word32Text = Encoding . EB.quote . B.word32Dec

300326

301−word64Text :: Word64 -> Encoding

327+word64Text :: Word64 -> Encoding' a

302328word64Text = Encoding . EB.quote . B.word64Dec

303329

304−wordText :: Word -> Encoding

330+wordText :: Word -> Encoding' a

305331wordText = Encoding . EB.quote . B.wordDec

306332

307−integerText :: Integer -> Encoding

333+integerText :: Integer -> Encoding' a

308334integerText = Encoding . EB.quote . B.integerDec

309335

310−-- | TODO: check infinite and nan?

311−floatText :: Float -> Encoding

336+floatText :: Float -> Encoding' a

312337floatText = Encoding . EB.quote . B.floatDec

313338

314−doubleText :: Double -> Encoding

339+doubleText :: Double -> Encoding' a

315340doubleText = Encoding . EB.quote . B.doubleDec

316341

317−scientificText :: Scientific -> Encoding

342+scientificText :: Scientific -> Encoding' a

318343scientificText = Encoding . EB.quote . EB.scientific

319344

320345-------------------------------------------------------------------------------

321346-- time

322347-------------------------------------------------------------------------------

323348

324−day :: Day -> Encoding

349+day :: Day -> Encoding' a

325350day = Encoding . EB.quote . EB.day

326351

327−localTime :: LocalTime -> Encoding

352+localTime :: LocalTime -> Encoding' a

328353localTime = Encoding . EB.quote . EB.localTime

329354

330−utcTime :: UTCTime -> Encoding

355+utcTime :: UTCTime -> Encoding' a

331356utcTime = Encoding . EB.quote . EB.utcTime

332357

333−timeOfDay :: TimeOfDay -> Encoding

358+timeOfDay :: TimeOfDay -> Encoding' a

334359timeOfDay = Encoding . EB.quote . EB.timeOfDay

335360

336−zonedTime :: ZonedTime -> Encoding

361+zonedTime :: ZonedTime -> Encoding' a

337362zonedTime = Encoding . EB.quote . EB.zonedTime

338363

339364-------------------------------------------------------------------------------

Data/Aeson/TH.hs+4−5

@@ -141,7 +141,6 @@ import Data.List ( (++), all, any, find, foldl, foldl'

141141import Data.List.NonEmpty ( NonEmpty((:|)), (<|) )

142142import Data.Map ( Map )

143143import Data.Maybe ( Maybe(Nothing, Just), catMaybes, fromMaybe, mapMaybe )

144−import Data.Monoid ( (<>), mconcat )

145144import Data.Set ( Set )

146145import Language.Haskell.TH

147146#if MIN_VERSION_template_haskell(2,8,0)

@@ -581,7 +580,7 @@ isMaybe (_, _, (_, _, AppT (ConT t) _)) = t == ''Maybe

581580isMaybe _ = False

582581

583582(<^>) :: ExpQ -> ExpQ -> ExpQ

584−(<^>) a b = infixApp a [|(<>)|] b

583+(<^>) a b = infixApp a [|(E.><)|] b

585584infixr 6 <^>

586585

587586(<:>) :: ExpQ -> ExpQ -> ExpQ

@@ -660,10 +659,10 @@ argsToEncoding jc tes opts multiCons (RecC conName ts) = case (unwrapUnaryRecord

660659 (argTys, tvMap) <- reifyConTys jc tes conName

661660 let exp = object objBody

662661

663− objBody = [|mconcat|] `appE`

662+ objBody = [|E.econcat|] `appE`

664663 ([|intersperse E.comma|] `appE` pairs)

665664 pairs | omitNothingFields opts = infixApp maybeFields

666− [|(<>)|]

665+ [|(++)|]

667666 restFields

668667 | otherwise = listE (map toPair argCons)

669668

@@ -680,7 +679,7 @@ argsToEncoding jc tes opts multiCons (RecC conName ts) = case (unwrapUnaryRecord

680679 (infixApp

681680 (infixE

682681 (Just $ toFieldName field <^> [|E.colon|])

683− [|(<>)|]

682+ [|(E.><)|]

684683 Nothing)

685684 [|(.)|]

686685 (dispatchToEncoding jc conName tvMap argTy))

Data/Aeson/Types/ToJSON.hs+40−43

@@ -55,8 +55,8 @@ module Data.Aeson.Types.ToJSON (

5555import Prelude ()

5656import Prelude.Compat

5757

58−import Data.Aeson.Encoding.Internal (Encoding (..), Series, dict, emptyArray_,

59− tuple, (>*<))

58+import Data.Aeson.Encoding.Internal (Encoding, Encoding', Series, dict,

59+ emptyArray_, tuple, (>*<), (><))

6060import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)

6161import Data.Aeson.Types.Generic

6262import Data.Aeson.Types.Internal

@@ -92,7 +92,6 @@ import Foreign.Storable (Storable)

9292import GHC.Generics

9393import Numeric.Natural (Natural)

9494

95−import qualified Data.ByteString.Builder as B (toLazyByteString)

9695import qualified Data.ByteString.Lazy as L

9796import qualified Data.DList as DList

9897import qualified Data.HashMap.Strict as H

@@ -423,7 +422,7 @@ class ToJSONKey a where

423422 toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)

424423

425424data ToJSONKeyFunction a

426− = ToJSONKeyText (a -> Text, a -> Encoding) -- ^ key is encoded to string, produces object

425+ = ToJSONKeyText (a -> Text, a -> Encoding' Text) -- ^ key is encoded to string, produces object

427426 | ToJSONKeyValue (a -> Value, a -> Encoding) -- ^ key is encoded to value, produces array

428427

429428contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b

@@ -672,7 +671,7 @@ instance ( AllNullary (a :+: b) allNullary

672671 -- 'allNullaryToStringTag' option is set they are encoded to

673672 -- strings. This distinction is made by 'sumToEncoding':

674673 gToEncoding opts pa te tel

675− = (unTagged :: Tagged allNullary Encoding -> Encoding)

674+ = (unTagged :: Tagged allNullary (Encoding) -> Encoding)

676675 . sumToEncoding opts pa te tel

677676

678677instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where

@@ -724,7 +723,7 @@ nonAllNullarySumToJSON opts pa tj tjl =

724723class SumToEncoding arity f allNullary where

725724 sumToEncoding :: Options -> Proxy arity

726725 -> (a -> Encoding) -> ([a] -> Encoding)

727− -> f a -> Tagged allNullary Encoding

726+ -> f a -> Tagged allNullary (Encoding)

728727

729728instance ( GetConName f

730729 , TaggedObjectEnc arity f

@@ -818,29 +817,28 @@ instance ( IsRecord a isRecord

818817 , Constructor c

819818 ) => TaggedObjectEnc arity (C1 c a) where

820819 taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =

821− E.openCurly <>

822− (toEncoding tagFieldName <>

823− E.colon <>

824− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>

825− ((unTagged :: Tagged isRecord Encoding -> Encoding) .

826− taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v) <>

827− E.closeCurly

820+ E.wrapObject $

821+ (E.string tagFieldName ><

822+ E.colon ><

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

824+ ((unTagged :: Tagged isRecord (Encoding) -> Encoding) .

825+ taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v)

828826

829827class TaggedObjectEnc' arity f isRecord where

830828 taggedObjectEnc' :: Options -> Proxy arity

831829 -> String -> (a -> Encoding) -> ([a] -> Encoding)

832− -> f a -> Tagged isRecord Encoding

830+ -> f a -> Tagged isRecord (Encoding)

833831

834832instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where

835− taggedObjectEnc' _ _ _ _ _ _ = Tagged mempty

833+ taggedObjectEnc' _ _ _ _ _ _ = Tagged E.empty

836834

837835instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where

838− taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma <>) . fst

836+ taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma ><) . fst

839837 . recordToEncoding opts pa te tel

840838

841839instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where

842840 taggedObjectEnc' opts pa contentsFieldName te tel =

843− Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .

841+ Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .

844842 gToEncoding opts pa te tel

845843

846844--------------------------------------------------------------------------------

@@ -942,13 +940,13 @@ class ConsToEncoding' arity f isRecord where

942940 consToEncoding' :: Options -> Proxy arity

943941 -> Bool -- ^ Are we a record with one field?

944942 -> (a -> Encoding) -> ([a] -> Encoding)

945− -> f a -> Tagged isRecord Encoding

943+ -> f a -> Tagged isRecord (Encoding)

946944

947945instance ( IsRecord f isRecord

948946 , ConsToEncoding' arity f isRecord

949947 ) => ConsToEncoding arity f where

950948 consToEncoding opts pa te tel =

951− (unTagged :: Tagged isRecord Encoding -> Encoding)

949+ (unTagged :: Tagged isRecord (Encoding) -> (Encoding))

952950 . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel

953951

954952instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where

@@ -999,39 +997,40 @@ class RecordToEncoding arity f where

999997 -- of the field (without the key); 'Nothing' otherwise

1000998 recordToEncoding :: Options -> Proxy arity

1001999 -> (a -> Encoding) -> ([a] -> Encoding)

1002− -> f a -> (Encoding, Maybe Encoding)

1000+ -> f a -> (Encoding, Maybe (Encoding))

10031001

10041002instance ( RecordToEncoding arity a

10051003 , RecordToEncoding arity b

10061004 ) => RecordToEncoding arity (a :*: b) where

10071005 recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =

1008− (mconcat $ intersperse E.comma $

1006+ (E.econcat $ intersperse E.comma $

10091007 filter (not . E.nullEncoding)

10101008 [ fst (recordToEncoding opts pa te tel a)

10111009 , fst (recordToEncoding opts pa te tel b) ]

10121010 , Nothing)

10131011 recordToEncoding opts pa te tel (a :*: b) =

1014− (fst (recordToEncoding opts pa te tel a) <> E.comma <>

1012+ (fst (recordToEncoding opts pa te tel a) >< E.comma ><

10151013 fst (recordToEncoding opts pa te tel b),

10161014 Nothing)

10171015

1016+

10181017instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where

10191018 recordToEncoding = fieldToEncoding

10201019

10211020instance OVERLAPPING_ (Selector s, ToJSON a) =>

10221021 RecordToEncoding arity (S1 s (K1 i (Maybe a))) where

10231022 recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts

1024− , K1 Nothing <- k1 = (mempty, Nothing)

1023+ , K1 Nothing <- k1 = (E.empty, Nothing)

10251024 recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1

10261025

10271026fieldToEncoding :: (Selector s, GToEncoding arity a)

10281027 => Options -> Proxy arity

10291028 -> (p -> Encoding) -> ([p] -> Encoding)

1030− -> S1 s a p -> (Encoding, Maybe Encoding)

1029+ -> S1 s a p -> (Encoding, Maybe (Encoding))

10311030fieldToEncoding opts pa te tel m1 =

10321031 let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)

10331032 valueBuilder = gToEncoding opts pa te tel (unM1 m1)

1034− in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)

1033+ in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)

10351034

10361035--------------------------------------------------------------------------------

10371036

@@ -1066,21 +1065,20 @@ instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where

10661065class EncodeProduct arity f where

10671066 encodeProduct :: Options -> Proxy arity

10681067 -> (a -> Encoding) -> ([a] -> Encoding)

1069− -> f a -> Encoding

1068+ -> f a -> Encoding' E.InArray

10701069

10711070instance ( EncodeProduct arity a

10721071 , EncodeProduct arity b

10731072 ) => EncodeProduct arity (a :*: b) where

10741073 encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =

1075− mconcat $ intersperse E.comma $

1074+ E.econcat $ intersperse E.comma $

10761075 filter (not . E.nullEncoding)

10771076 [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]

1078− encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a <>

1079− E.comma <>

1077+ encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a >*<

10801078 encodeProduct opts pa te tel b

10811079

10821080instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where

1083− encodeProduct opts = gToEncoding opts

1081+ encodeProduct opts pa te tel a = E.retagEncoding $ gToEncoding opts pa te tel a

10841082

10851083--------------------------------------------------------------------------------

10861084

@@ -1126,12 +1124,12 @@ instance ( GToEncoding arity a

11261124 , Constructor c

11271125 ) => ObjectWithSingleFieldEnc arity (C1 c a) where

11281126 objectWithSingleFieldEnc opts pa te tel v =

1129− E.openCurly <>

1127+ E.openCurly ><

11301128 toEncoding

11311129 (constructorTagModifier opts

1132− (conName (undefined :: t c a p))) <>

1133− E.colon <>

1134− gToEncoding opts pa te tel v <>

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

1131+ E.colon ><

1132+ gToEncoding opts pa te tel v ><

11351133 E.closeCurly

11361134

11371135-------------------------------------------------------------------------------

@@ -1235,7 +1233,7 @@ instance ToJSON Bool where

12351233instance ToJSONKey Bool where

12361234 toJSONKey = ToJSONKeyText

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

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

1236+ , (\x -> E.text $ if x then "true"else "false")

12391237 )

12401238

12411239

@@ -1481,7 +1479,7 @@ instance ToJSON Text where

14811479 {-# INLINE toEncoding #-}

14821480

14831481instance ToJSONKey Text where

1484− toJSONKey = ToJSONKeyText (id, toEncoding)

1482+ toJSONKey = ToJSONKeyText (id, E.text)

14851483 {-# INLINE toJSONKey #-}

14861484

14871485instance ToJSON LT.Text where

@@ -1819,13 +1817,12 @@ instance ToJSONKey UTCTime where

18191817 toJSONKey = toJSONKeyTextEnc E.utcTime

18201818

18211819-- | Encode something t a JSON string.

1822−stringEncoding :: Encoding -> Value

1820+stringEncoding :: Encoding' Text -> Value

18231821stringEncoding = String

18241822 . T.dropAround (== '"')

18251823 . T.decodeLatin1

18261824 . L.toStrict

1827− . B.toLazyByteString

1828− . fromEncoding

1825+ . E.encodingToLazyByteString

18291826{-# INLINE stringEncoding #-}

18301827

18311828instance ToJSON NominalDiffTime where

@@ -1920,10 +1917,10 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where

19201917

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

19221919-- export and document this function from there

1923−toJSONKeyTextEnc :: (a -> Encoding) -> ToJSONKeyFunction a

1920+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a

19241921toJSONKeyTextEnc e = ToJSONKeyText

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

1926− ( T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . B.toLazyByteString . fromEncoding . e

1923+ ( T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . E.encodingToLazyByteString . e

19271924 , e

19281925 )

19291926

@@ -1932,8 +1929,8 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)

19321929instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)

19331930

19341931instance ToJSONKey Char where

1935− toJSONKey = ToJSONKeyText (T.singleton, toEncoding)

1936− toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)

1932+ toJSONKey = ToJSONKeyText (T.singleton, E.string . (:[]))

1933+ toJSONKeyList = ToJSONKeyText (T.pack, E.text . T.pack)

19371934

19381935instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where

19391936 toJSONKey = toJSONKeyList

tests/UnitTests.hs−1

@@ -13,7 +13,6 @@ import Prelude.Compat

1313import Control.Applicative (Const(..))

1414import Control.Monad (forM)

1515import Data.Aeson (FromJSONKeyFunction(..), FromJSONKey(..), decode, eitherDecode, encode, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))

16−import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))

1716import Data.Aeson.Text (encodeToTextBuilder)

1817import Data.Aeson.Internal (JSONPathElement(..), formatError)

1918import Data.Aeson.TH (deriveJSON)