737ed5c · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #422 from phadej/encoding-refactoring-final

Encoding refactoring final

commit737ed5c3e81993b7b079557b029de84c94a85d50 authorAdam Bergmark <adam@bergmark.nl> dateMon 13 Jun 2016, 18:01 (10 years ago) parentf81a260 146020c

19 files changed+395−318

compare with master

unifiedsplit

Data/Aeson.hs+7−1 Data/Aeson/Encode.hs+12−94 Data/Aeson/Encode/Functions.hs−14 Data/Aeson/Encoding.hs+7 Data/Aeson/Encode/Builder.hs → Data/Aeson/Encoding/Builder.hs+2−2 Data/Aeson/Encoding/Internal.hs+95−70 Data/Aeson/Functions.hs → Data/Aeson/Internal/Functions.hs+1−8 Data/Aeson/TH.hs+4−5 Data/Aeson/Text.hs+97 Data/Aeson/Types.hs+3 Data/Aeson/Types/Class.hs+1 Data/Aeson/Types/FromJSON.hs+34−12 Data/Aeson/Types/ToJSON.hs+105−93 aeson.cabal+12−7 benchmarks/CompareWithJSON.hs+1−1 benchmarks/Micro.hs+1−1 benchmarks/aeson-benchmarks.cabal+7−6 tests/Properties.hs+5−2 tests/UnitTests.hs+1−2

Data/Aeson.hs+7−1

@@ -109,7 +109,7 @@ module Data.Aeson

109109 ) where

110110

111111import Data.Aeson.Types.FromJSON (ifromJSON)

112−import Data.Aeson.Encode (encode)

112+import Data.Aeson.Encoding (encodingToLazyByteString)

113113import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,

114114 eitherDecodeWith, eitherDecodeStrictWith,

115115 jsonEOF, json, jsonEOF', json')

@@ -118,6 +118,12 @@ import Data.Aeson.Types.Internal (JSONPath, formatError)

118118import qualified Data.ByteString as B

119119import qualified Data.ByteString.Lazy as L

120120

121+-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.

122+--

123+-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.

124+encode :: (ToJSON a) => a -> L.ByteString

125+encode = encodingToLazyByteString . toEncoding

126+

121127-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.

122128-- If this fails due to incomplete or invalid input, 'Nothing' is

123129-- returned.

Data/Aeson/Encode.hs+12−94

@@ -1,5 +1,3 @@

1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2−

31-- |

42-- Module: Data.Aeson.Encode

@@ -9,102 +7,22 @@

97-- Stability: experimental

108-- Portability: portable

119--

12−-- Efficiently serialize a JSON value.

13−--

14−-- Most frequently, you'll probably want to encode straight to UTF-8

15−-- (the standard JSON encoding) using 'encode'.

16−--

17−-- You can use the conversions to 'Builder's when embedding JSON messages as

18−-- parts of a protocol.

19−module Data.Aeson.Encode

10+-- This module is left to supply limited backwards-compatibility.

11+module Data.Aeson.Encode {-# DEPRECATED "Use Data.Aeson or Data.Aeson.Text instead" #-}

2012 ( encode

21−

22− -- * Encoding to Builders

23− , encodeToBuilder

2413 , encodeToTextBuilder

25−

26− -- * Deprecated

27− , fromValue

2814 ) where

2915

30−import Data.Aeson.Encode.Builder (encodeToBuilder)

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

32−import Data.Aeson.Encoding (fromEncoding)

33−import Data.Monoid ((<>))

34−import Data.Scientific (FPFormat(..), Scientific, base10Exponent)

35−import Data.Text.Lazy.Builder

36−import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)

37−

38−import Numeric (showHex)

39−import qualified Data.ByteString.Builder as B

40−import qualified Data.HashMap.Strict as H

41−import qualified Data.Text as T

42−import qualified Data.Vector as V

43−import qualified Data.ByteString.Lazy as L

44−

45−-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.

46−--

47−-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.

48−encode :: ToJSON a => a -> L.ByteString

49−encode = B.toLazyByteString . fromEncoding . toEncoding

50−{-# INLINE encode #-}

51−

52−-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be

53−-- embedded efficiently in a text-based protocol.

54−--

55−-- If you are going to immediately encode straight to a

56−-- 'L.ByteString', it is more efficient to use 'encodeToBuilder'

57−-- instead.

58−encodeToTextBuilder :: Value -> Builder

59−encodeToTextBuilder =

60− go

61− where

62− go Null = {-# SCC "go/Null" #-} "null"

63− go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"

64− go (Number s) = {-# SCC "go/Number" #-} fromScientific s

65− go (String s) = {-# SCC "go/String" #-} string s

66− go (Array v)

67− | V.null v = {-# SCC "go/Array" #-} "[]"

68− | otherwise = {-# SCC "go/Array" #-}

69− singleton '[' <>

70− go (V.unsafeHead v) <>

71− V.foldr f (singleton ']') (V.unsafeTail v)

72− where f a z = singleton ',' <> go a <> z

73− go (Object m) = {-# SCC "go/Object" #-}

74− case H.toList m of

75− (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs

76− _ -> "{}"

77− where f a z = singleton ',' <> one a <> z

78− one (k,v) = string k <> singleton ':' <> go v

79−

80−{-# DEPRECATED fromValue "Use 'encodeToTextBuilder' instead" #-}

81−fromValue :: Value -> Builder

82−fromValue = encodeToTextBuilder

16+import Data.ByteString.Lazy (ByteString)

17+import Data.Text.Lazy.Builder (Builder)

8318

84−string :: T.Text -> Builder

85−string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'

86− where

87− quote q = case T.uncons t of

88− Nothing -> fromText h

89− Just (!c,t') -> fromText h <> escape c <> quote t'

90− where (h,t) = {-# SCC "break" #-} T.break isEscape q

91− isEscape c = c == '\"' ||

92− c == '\\' ||

93− c < '\x20'

94− escape '\"' = "\\\""

95− escape '\\' = "\\\\"

96− escape '\n' = "\\n"

97− escape '\r' = "\\r"

98− escape '\t' = "\\t"

19+import qualified Data.Aeson as A

20+import qualified Data.Aeson.Text as A

9921

100− escape c

101− | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h

102− | otherwise = singleton c

103− where h = showHex (fromEnum c) ""

22+encode :: A.ToJSON a => a -> ByteString

23+encode = A.encode

24+{-# DEPRECATED encode "Use encode from Data.Aeson" #-}

10425

105−fromScientific :: Scientific -> Builder

106−fromScientific s = formatScientificBuilder format prec s

107− where

108− (format, prec)

109− | base10Exponent s < 0 = (Generic, Nothing)

110− | otherwise = (Fixed, Just 0)

26+encodeToTextBuilder :: A.Value -> Builder

27+encodeToTextBuilder = A.encodeToTextBuilder

28+{-# DEPRECATED encodeToTextBuilder "Use encodeTotextBuilder from Data.Aeson.Text" #-}

Data/Aeson/Encode/Functions.hsdeleted−14

@@ -1,14 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−

3−module Data.Aeson.Encode.Functions

4− (

5− builder

6− ) where

7−

8−import Data.Aeson.Encoding

9−import Data.Aeson.Types.Class

10−import Data.ByteString.Builder (Builder)

11−import Data.Monoid ((<>))

12−

13−

14−{-# INLINE builder #-}

Data/Aeson/Encoding.hs+7

@@ -1,7 +1,14 @@

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'

11+ , encodingToLazyByteString

512 , fromEncoding

613 , unsafeToEncoding

714 , Series

Data/Aeson/Encode/Builder.hs → Data/Aeson/Encoding/Builder.hsrenamed+2−2

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

11{-# LANGUAGE BangPatterns, OverloadedStrings #-}

33-- |

4−-- Module: Data.Aeson.Encode.Builder

4+-- Module: Data.Aeson.Encoding.Builder

77-- License: BSD3

@@ -11,7 +11,7 @@

1111--

1212-- Efficiently serialize a JSON value using the UTF-8 encoding.

1313

14−module Data.Aeson.Encode.Builder

14+module Data.Aeson.Encoding.Builder

1515 (

1616 encodeToBuilder

1717 , null_

Data/Aeson/Encoding/Internal.hs+95−70

@@ -1,13 +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

8+ Encoding' (..)

9+ , Encoding

10+ , encodingToLazyByteString

911 , unsafeToEncoding

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

12+ , retagEncoding

13+ , Series (..)

1114 , pairs

1215 , pair

1316 -- * Predicates

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

1518 -- * Encoding constructors

1619 , emptyArray_

1720 , emptyObject_

18− , wrapArray

1921 , wrapObject

22+ , wrapArray

2023 , null_

2124 , bool

2225 , text

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

2629 , dict

2730 , tuple

2831 , (>*<)

32+ , InArray

33+ , empty

34+ , (><)

35+ , econcat

2936 -- ** Decimal numbers

3037 , int8, int16, int32, int64, int

3138 , word8, word16, word32, word64, word

@@ -62,35 +69,48 @@ import Data.Word

6269

6370import Data.Aeson.Types.Internal (Value)

6471

65−import qualified Data.Aeson.Encode.Builder as EB

66−import qualified Data.ByteString.Builder as B

67−import qualified Data.ByteString.Lazy as BSL

68−import qualified Data.Text.Lazy as LT

72+import qualified Data.Aeson.Encoding.Builder as EB

73+import qualified Data.ByteString.Builder as B

74+import qualified Data.ByteString.Lazy as BSL

75+import qualified Data.Text.Lazy as LT

6976

7077-- | An encoding of a JSON value.

71−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 {

7282 fromEncoding :: Builder

7383 -- ^ Acquire the underlying bytestring builder.

74− } deriving (Semigroup,Monoid,Typeable)

84+ } deriving (Typeable)

85+

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

87+type Encoding = Encoding' Value

7588

7689-- | Make Encoding from Builder.

7790--

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

7992-- is a valid JSON Encoding!

80−unsafeToEncoding :: Builder -> Encoding

93+unsafeToEncoding :: Builder -> Encoding' a

8194unsafeToEncoding = Encoding

8295

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

97+encodingToLazyByteString = toLazyByteString . fromEncoding

98+{-# INLINE encodingToLazyByteString #-}

99+

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

101+retagEncoding = Encoding . fromEncoding

102+

83103-------------------------------------------------------------------------------

84104-- Encoding instances

85105-------------------------------------------------------------------------------

86106

87−instance Show Encoding where

107+instance Show (Encoding' a) where

88108 show (Encoding e) = show (toLazyByteString e)

89109

90−instance Eq Encoding where

110+instance Eq (Encoding' a) where

91111 Encoding a == Encoding b = toLazyByteString a == toLazyByteString b

92112

93−instance Ord Encoding where

113+instance Ord (Encoding' a) where

94114 compare (Encoding a) (Encoding b) =

95115 compare (toLazyByteString a) (toLazyByteString b)

96116

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

102122--

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

104124data Series = Empty

105− | Value Encoding

125+ | Value (Encoding' Series)

106126 deriving (Typeable)

107127

108128pair :: Text -> Encoding -> Series

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

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

110130

111131instance Semigroup Series where

112− Empty <> a = a

113− Value a <> b =

114− Value $

115− a <> case b of

116− Empty -> mempty

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

132+ Empty <> a = a

133+ a <> Empty = a

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

118135

119136instance Monoid Series where

120137 mempty = Empty

121138 mappend = (<>)

122139

123−nullEncoding :: Encoding -> Bool

140+nullEncoding :: Encoding' a -> Bool

124141nullEncoding = BSL.null . toLazyByteString . fromEncoding

125142

126143emptyArray_ :: Encoding

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

129146emptyObject_ :: Encoding

130147emptyObject_ = Encoding EB.emptyObject_

131148

132−wrapArray :: Encoding -> Encoding

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

149+wrapArray :: Encoding' a -> Encoding

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

134151

135−wrapObject :: Encoding -> Encoding

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

152+wrapObject :: Encoding' a -> Encoding

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

137154

138155null_ :: Encoding

139156null_ = Encoding EB.null_

@@ -144,41 +161,50 @@ bool False = Encoding "false"

144161

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

146163pairs :: Series -> Encoding

147−pairs = brackets '{' '}'

164+pairs (Value v) = openCurly >< retagEncoding v >< closeCurly

165+pairs Empty = emptyObject_

148166{-# INLINE pairs #-}

149167

150−brackets :: Char -> Char -> Series -> Encoding

151−brackets begin end (Value v) = Encoding $

152− char7 begin <> fromEncoding v <> char7 end

153−brackets begin end Empty = Encoding (primBounded (EB.ascii2 (begin,end)) ())

154−

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

156169list _ [] = emptyArray_

157−list to' (x:xs) = Encoding $

158− char7 '[' <> fromEncoding (to' x) <> commas xs <> char7 ']'

170+list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket

159171 where

160− commas = foldr (\v vs -> char7 ',' <> fromEncoding (to' v) <> vs) mempty

172+ commas = foldr (\v vs -> comma >< to' v >< vs) empty

161173{-# INLINE list #-}

162174

163175-- | Encode as JSON object

164176dict

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

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

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

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

168180 -> m -- ^ container

169181 -> Encoding

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

182+dict encodeKey encodeVal foldrWithKey = pairs . foldrWithKey go mempty

171183 where

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

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

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

174186{-# INLINE dict #-}

175187

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

189+data InArray

190+

176191infixr 6 >*<

177192-- | See 'tuple'.

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

179−Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b

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

194+a >*< b = retagEncoding a >< comma >< retagEncoding b

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

181196

197+empty :: Encoding' a

198+empty = Encoding mempty

199+

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

201+econcat = foldr (><) empty

202+

203+infixr 6 ><

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

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

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

207+

182208-- | Encode as a tuple.

183209--

184210-- @

@@ -186,26 +212,26 @@ Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b

186212-- toEncoding a >*<

187213-- toEncoding b >*<

188214-- toEncoding c

189−tuple :: Encoding -> Encoding

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

215+tuple :: Encoding' InArray -> Encoding

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

191217{-# INLINE tuple #-}

192218

193−text :: Text -> Encoding

219+text :: Text -> Encoding' a

194220text = Encoding . EB.text

195221

196−lazyText :: LT.Text -> Encoding

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

197223lazyText t = Encoding $

198224 B.char7 '"' <>

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

200226

201−string :: String -> Encoding

227+string :: String -> Encoding' a

202228string = Encoding . EB.string

203229

204230-------------------------------------------------------------------------------

205231-- chars

206232-------------------------------------------------------------------------------

207233

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

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

209235comma = Encoding $ char7 ','

210236colon = Encoding $ char7 ':'

211237openBracket = Encoding $ char7 '['

@@ -269,66 +295,65 @@ realFloatToEncoding e d

269295-- Decimal numbers as Text

270296-------------------------------------------------------------------------------

271297

272−int8Text :: Int8 -> Encoding

298+int8Text :: Int8 -> Encoding' a

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

274300

275−int16Text :: Int16 -> Encoding

301+int16Text :: Int16 -> Encoding' a

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

277303

278−int32Text :: Int32 -> Encoding

304+int32Text :: Int32 -> Encoding' a

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

280306

281−int64Text :: Int64 -> Encoding

307+int64Text :: Int64 -> Encoding' a

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

283309

284−intText :: Int -> Encoding

310+intText :: Int -> Encoding' a

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

286312

287−word8Text :: Word8 -> Encoding

313+word8Text :: Word8 -> Encoding' a

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

289315

290−word16Text :: Word16 -> Encoding

316+word16Text :: Word16 -> Encoding' a

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

292318

293−word32Text :: Word32 -> Encoding

319+word32Text :: Word32 -> Encoding' a

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

295321

296−word64Text :: Word64 -> Encoding

322+word64Text :: Word64 -> Encoding' a

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

298324

299−wordText :: Word -> Encoding

325+wordText :: Word -> Encoding' a

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

301327

302−integerText :: Integer -> Encoding

328+integerText :: Integer -> Encoding' a

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

304330

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

306−floatText :: Float -> Encoding

331+floatText :: Float -> Encoding' a

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

308333

309−doubleText :: Double -> Encoding

334+doubleText :: Double -> Encoding' a

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

311336

312−scientificText :: Scientific -> Encoding

337+scientificText :: Scientific -> Encoding' a

313338scientificText = Encoding . EB.quote . EB.scientific

314339

315340-------------------------------------------------------------------------------

316341-- time

317342-------------------------------------------------------------------------------

318343

319−day :: Day -> Encoding

344+day :: Day -> Encoding' a

320345day = Encoding . EB.quote . EB.day

321346

322−localTime :: LocalTime -> Encoding

347+localTime :: LocalTime -> Encoding' a

323348localTime = Encoding . EB.quote . EB.localTime

324349

325−utcTime :: UTCTime -> Encoding

350+utcTime :: UTCTime -> Encoding' a

326351utcTime = Encoding . EB.quote . EB.utcTime

327352

328−timeOfDay :: TimeOfDay -> Encoding

353+timeOfDay :: TimeOfDay -> Encoding' a

329354timeOfDay = Encoding . EB.quote . EB.timeOfDay

330355

331−zonedTime :: ZonedTime -> Encoding

356+zonedTime :: ZonedTime -> Encoding' a

332357zonedTime = Encoding . EB.quote . EB.zonedTime

333358

334359-------------------------------------------------------------------------------

Data/Aeson/Functions.hs → Data/Aeson/Internal/Functions.hsrenamed+1−8

@@ -7,9 +7,8 @@

77-- Stability: experimental

88-- Portability: portable

10−module Data.Aeson.Functions

10+module Data.Aeson.Internal.Functions

1111 ( mapHashKeyVal

12− , hashMapKey

1312 , mapKeyVal

1413 , mapKey

1514 ) where

@@ -24,12 +23,6 @@ mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)

2423mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty

2524{-# INLINE mapHashKeyVal #-}

2625

27−-- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.

28−hashMapKey :: (Ord k2) => (k1 -> k2)

29− -> H.HashMap k1 v -> M.Map k2 v

30−hashMapKey kv = H.foldrWithKey (M.insert . kv) M.empty

31−{-# INLINE hashMapKey #-}

32−

3326-- | Transform the keys and values of a 'H.HashMap'.

3427mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)

3528 -> H.HashMap k1 v1 -> H.HashMap k2 v2

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/Text.hsnew file+97

@@ -0,0 +1,97 @@

1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2+-- |

3+-- Module: Data.Aeson.Text

6+-- License: BSD3

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

8+-- Stability: experimental

9+-- Portability: portable

10+--

11+-- Most frequently, you'll probably want to encode straight to UTF-8

12+-- (the standard JSON encoding) using 'encode'.

13+--

14+-- You can use the conversions to 'Builder's when embedding JSON messages as

15+-- parts of a protocol.

16+module Data.Aeson.Text

17+ ( encodeToLazyText

18+ , encodeToTextBuilder

19+ ) where

20+

21+import Data.Aeson.Types (Value(..), ToJSON(..))

22+import Data.Aeson.Encoding (encodingToLazyByteString)

23+import Data.Monoid ((<>))

24+import Data.Scientific (FPFormat(..), Scientific, base10Exponent)

25+import Data.Text.Lazy.Builder

26+import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)

27+

28+import Numeric (showHex)

29+import qualified Data.HashMap.Strict as H

30+import qualified Data.Text as T

31+import qualified Data.Text.Lazy as LT

32+import qualified Data.Text.Lazy.Encoding as LT

33+import qualified Data.Vector as V

34+

35+-- | Encode a JSON 'Value' to a "Data.Text.Lazy"

36+--

37+-- /Note:/ uses 'toEncoding'

38+encodeToLazyText :: ToJSON a => a -> LT.Text

39+encodeToLazyText = LT.decodeUtf8 . encodingToLazyByteString . toEncoding

40+

41+-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be

42+-- embedded efficiently in a text-based protocol.

43+--

44+-- If you are going to immediately encode straight to a

45+-- 'L.ByteString', it is more efficient to use 'encodeToBuilder'

46+-- instead.

47+--

48+-- /Note:/ Uses 'toJSON'

49+encodeToTextBuilder :: ToJSON a => a -> Builder

50+encodeToTextBuilder =

51+ go . toJSON

52+ where

53+ go Null = {-# SCC "go/Null" #-} "null"

54+ go (Bool b) = {-# SCC "go/Bool" #-} if b then "true" else "false"

55+ go (Number s) = {-# SCC "go/Number" #-} fromScientific s

56+ go (String s) = {-# SCC "go/String" #-} string s

57+ go (Array v)

58+ | V.null v = {-# SCC "go/Array" #-} "[]"

59+ | otherwise = {-# SCC "go/Array" #-}

60+ singleton '[' <>

61+ go (V.unsafeHead v) <>

62+ V.foldr f (singleton ']') (V.unsafeTail v)

63+ where f a z = singleton ',' <> go a <> z

64+ go (Object m) = {-# SCC "go/Object" #-}

65+ case H.toList m of

66+ (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs

67+ _ -> "{}"

68+ where f a z = singleton ',' <> one a <> z

69+ one (k,v) = string k <> singleton ':' <> go v

70+

71+string :: T.Text -> Builder

72+string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'

73+ where

74+ quote q = case T.uncons t of

75+ Nothing -> fromText h

76+ Just (!c,t') -> fromText h <> escape c <> quote t'

77+ where (h,t) = {-# SCC "break" #-} T.break isEscape q

78+ isEscape c = c == '\"' ||

79+ c == '\\' ||

80+ c < '\x20'

81+ escape '\"' = "\\\""

82+ escape '\\' = "\\\\"

83+ escape '\n' = "\\n"

84+ escape '\r' = "\\r"

85+ escape '\t' = "\\t"

86+

87+ escape c

88+ | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h

89+ | otherwise = singleton c

90+ where h = showHex (fromEnum c) ""

91+

92+fromScientific :: Scientific -> Builder

93+fromScientific s = formatScientificBuilder format prec s

94+ where

95+ (format, prec)

96+ | base10Exponent s < 0 = (Generic, Nothing)

97+ | otherwise = (Fixed, Just 0)

Data/Aeson/Types.hs+3

@@ -40,10 +40,13 @@ module Data.Aeson.Types

4040 -- ** Keys for maps

4141 , ToJSONKey(..)

4242 , ToJSONKeyFunction(..)

43+ , toJSONKeyText

44+ , contramapToJSONKeyFunction

4345 , FromJSONKey(..)

4446 , FromJSONKeyFunction(..)

4547 , fromJSONKeyCoerce

4648 , coerceFromJSONKeyFunction

49+ , mapFromJSONKeyFunction

4750

4851 -- ** Liftings to unary and binary type constructors

4952 , FromJSON1(..)

Data/Aeson/Types/Class.hs+1

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

5151 -- * Classes and types for map keys

5252 , ToJSONKey(..)

5353 , ToJSONKeyFunction(..)

54+ , toJSONKeyText

5455 , contramapToJSONKeyFunction

5556 , FromJSONKey(..)

5657 , FromJSONKeyFunction(..)

Data/Aeson/Types/FromJSON.hs+34−12

@@ -69,7 +69,7 @@ module Data.Aeson.Types.FromJSON (

6969import Prelude ()

7070import Prelude.Compat hiding (foldr)

7171

72−import Data.Aeson.Functions (mapKey)

72+import Data.Aeson.Internal.Functions (mapKey)

7373import Data.Aeson.Types.Generic

7474import Data.Aeson.Types.Internal

7575

@@ -127,9 +127,8 @@ import qualified Data.Vector.Unboxed as VU

127127

128128import Unsafe.Coerce (unsafeCoerce)

129129

130−-- Coercible derivations aren't as powerful on GHC 7.8, though supported.

131130#ifndef HAS_COERCIBLE

132−#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)

131+#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)

133132#endif

134133

135134#if HAS_COERCIBLE

@@ -325,6 +324,7 @@ class FromJSONKey a where

325324 fromJSONKey :: FromJSONKeyFunction a

326325 default fromJSONKey :: FromJSON a => FromJSONKeyFunction a

327326 fromJSONKey = FromJSONKeyValue parseJSON

327+

328328 fromJSONKeyList :: FromJSONKeyFunction [a]

329329 default fromJSONKeyList :: FromJSON a => FromJSONKeyFunction [a]

330330 fromJSONKeyList = FromJSONKeyValue parseJSON

@@ -343,10 +343,10 @@ data CoerceText a where

343343#endif

344344

345345data FromJSONKeyFunction a

346− = FromJSONKeyCoerce (CoerceText a)

347− | FromJSONKeyText (Text -> a)

348− | FromJSONKeyTextParser (Text -> Parser a)

349− | FromJSONKeyValue (Value -> Parser a)

346+ = FromJSONKeyCoerce !(CoerceText a)

347+ | FromJSONKeyText !(Text -> a)

348+ | FromJSONKeyTextParser !(Text -> Parser a)

349+ | FromJSONKeyValue !(Value -> Parser a)

350350

351351instance Functor FromJSONKeyFunction where

352352 fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')

@@ -357,6 +357,8 @@ instance Functor FromJSONKeyFunction where

357357-- | Construct 'FromJSONKeyFunction' for types coercible from 'Text'. This

358358-- conversion is still unsafe, as 'Hashable' and 'Eq' instances of @a@ should be

359359-- compatible with 'Text' i.e. hash values be equal for wrapped values as well.

360+--

361+-- On pre GHC 7.8 this is unconstrainted function.

360362fromJSONKeyCoerce ::

361363#if HAS_COERCIBLE

362364 Coercible Text a =>

@@ -364,15 +366,22 @@ fromJSONKeyCoerce ::

364366 FromJSONKeyFunction a

365367fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText

366368

369+-- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@.

370+--

371+-- See note on 'fromJSONKeyCoerce'.

367372coerceFromJSONKeyFunction ::

368373#if HAS_COERCIBLE

369374 Coercible a b =>

370375#endif

371376 FromJSONKeyFunction a -> FromJSONKeyFunction b

377+#if HAS_COERCIBLE

378+coerceFromJSONKeyFunction = coerce

379+#else

372380coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText

373381coerceFromJSONKeyFunction (FromJSONKeyText f) = FromJSONKeyText (coerce' . f)

374382coerceFromJSONKeyFunction (FromJSONKeyTextParser f) = FromJSONKeyTextParser (fmap coerce' . f)

375383coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fmap coerce' . f)

384+#endif

376385

377386{-# RULES

378387 "FromJSONKeyCoerce: fmap id" forall (x :: FromJSONKeyFunction a).

@@ -385,6 +394,7 @@ coerceFromJSONKeyFunction (FromJSONKeyValue f) = FromJSONKeyValue (fma

385394 #-}

386395#endif

387396

397+-- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.

388398mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b

389399mapFromJSONKeyFunction = fmap

390400

@@ -1177,6 +1187,7 @@ instance FromJSON Word64 where

11771187instance FromJSONKey Word64 where

11781188 fromJSONKey = FromJSONKeyTextParser parseIntegralText

11791189

1190+

11801191instance FromJSON Text where

11811192 parseJSON = withText "Text" pure

11821193 {-# INLINE parseJSON #-}

@@ -1184,17 +1195,28 @@ instance FromJSON Text where

11841195instance FromJSONKey Text where

11851196 fromJSONKey = fromJSONKeyCoerce

11861197

1198+

11871199instance FromJSON LT.Text where

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

11891201 {-# INLINE parseJSON #-}

11901202

1203+instance FromJSONKey LT.Text where

1204+ fromJSONKey = FromJSONKeyText LT.fromStrict

1205+

1206+

11911207instance FromJSON Version where

1208+ parseJSON = withText "Version" parseVersionText

11921209 {-# INLINE parseJSON #-}

1193− parseJSON = withText "Version" $ go . readP_to_S parseVersion . unpack

1194− where

1195− go [(v,[])] = return v

1196− go (_ : xs) = go xs

1197− go _ = fail $ "could not parse Version"

1210+

1211+instance FromJSONKey Version where

1212+ fromJSONKey = FromJSONKeyTextParser parseVersionText

1213+

1214+parseVersionText :: Text -> Parser Version

1215+parseVersionText = go . readP_to_S parseVersion . unpack

1216+ where

1217+ go [(v,[])] = return v

1218+ go (_ : xs) = go xs

1219+ go _ = fail $ "could not parse Version"

11981220

11991221-------------------------------------------------------------------------------

12001222-- semigroups NonEmpty

Data/Aeson/Types/ToJSON.hs+105−93

@@ -43,6 +43,7 @@ module Data.Aeson.Types.ToJSON (

4343 -- * Classes and types for map keys

4444 , ToJSONKey(..)

4545 , ToJSONKeyFunction(..)

46+ , toJSONKeyText

4647 , contramapToJSONKeyFunction

4748 -- * Object key-value pairs

4849 , KeyValue(..)

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

5556import Prelude ()

5657import Prelude.Compat

5758

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

59− tuple, (>*<))

60−import Data.Aeson.Functions (mapHashKeyVal, mapKeyVal)

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

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

61+import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)

6162import Data.Aeson.Types.Generic

6263import Data.Aeson.Types.Internal

6364

@@ -92,35 +93,30 @@ import Foreign.Storable (Storable)

9293import GHC.Generics

9394import Numeric.Natural (Natural)

9495

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

96−import qualified Data.ByteString.Lazy as L

97−import qualified Data.DList as DList

98−import qualified Data.HashMap.Strict as H

99−import qualified Data.HashSet as HashSet

100−import qualified Data.IntMap as IntMap

101−import qualified Data.IntSet as IntSet

102−import qualified Data.List.NonEmpty as NE

103−import qualified Data.Map as M

104−import qualified Data.Scientific as Scientific

105−import qualified Data.Sequence as Seq

106−import qualified Data.Set as Set

107−import qualified Data.Text as T

108−import qualified Data.Text.Encoding as T

109−import qualified Data.Text.Lazy as LT

110−import qualified Data.Tree as Tree

111−import qualified Data.Vector as V

112−import qualified Data.Vector.Generic as VG

113−import qualified Data.Vector.Mutable as VM

114−import qualified Data.Vector.Primitive as VP

115−import qualified Data.Vector.Storable as VS

116−import qualified Data.Vector.Unboxed as VU

96+import qualified Data.ByteString.Lazy as L

97+import qualified Data.DList as DList

98+import qualified Data.HashMap.Strict as H

99+import qualified Data.HashSet as HashSet

100+import qualified Data.IntMap as IntMap

101+import qualified Data.IntSet as IntSet

102+import qualified Data.List.NonEmpty as NE

103+import qualified Data.Map as M

104+import qualified Data.Scientific as Scientific

105+import qualified Data.Sequence as Seq

106+import qualified Data.Set as Set

107+import qualified Data.Text as T

108+import qualified Data.Text.Encoding as T

109+import qualified Data.Text.Lazy as LT

110+import qualified Data.Tree as Tree

111+import qualified Data.Vector as V

112+import qualified Data.Vector.Generic as VG

113+import qualified Data.Vector.Mutable as VM

114+import qualified Data.Vector.Primitive as VP

115+import qualified Data.Vector.Storable as VS

116+import qualified Data.Vector.Unboxed as VU

117117

118118toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

119−toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do

120− mv <- VM.unsafeNew 2

121− VM.unsafeWrite mv 0 (keySerialiser a)

122− VM.unsafeWrite mv 1 (valSerializer b)

123− return mv

119+toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

124120{-# INLINE toJSONPair #-}

125121

126122realFloatToJSON :: RealFloat a => a -> Value

@@ -418,22 +414,44 @@ class ToJSONKey a where

418414 -- container.

419415 toJSONKey :: ToJSONKeyFunction a

420416 default toJSONKey :: ToJSON a => ToJSONKeyFunction a

421− toJSONKey = ToJSONKeyValue (toJSON, toEncoding)

417+ toJSONKey = ToJSONKeyValue toJSON toEncoding

418+

422419 -- | This is similar in spirit to the 'showsList' method of 'Show'.

423420 -- It makes it possible to give 'String' keys special treatment

424421 -- without using @OverlappingInstances@.

425422 toJSONKeyList :: ToJSONKeyFunction [a]

426423 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]

427− toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)

424+ toJSONKeyList = ToJSONKeyValue toJSON toEncoding

428425

429426data ToJSONKeyFunction a

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

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

427+ = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)

428+ -- ^ key is encoded to string, produces object

429+ | ToJSONKeyValue !(a -> Value) !(a -> Encoding)

430+ -- ^ key is encoded to value, produces array

431+

432+-- | Helper for creating textual keys.

433+--

434+-- @

435+-- instance 'ToJSONKey' MyKey where

436+-- 'toJSONKey' = 'toJSONKeyText' myKeyToText

437+-- where

438+-- myKeyToText = Text.pack . show -- or showt from text-show

439+-- @

440+toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a

441+toJSONKeyText f = ToJSONKeyText f (E.text . f)

442+

443+-- | TODO: should this be exported?

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

445+toJSONKeyTextEnc e = ToJSONKeyText tot e

446+ where

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

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

432449

450+-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.

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

434452contramapToJSONKeyFunction h x = case x of

435− ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)

436− ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)

453+ ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)

454+ ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)

437455

438456-------------------------------------------------------------------------------

439457-- Lifings of FromJSON and ToJSON to unary and binary type constructors

@@ -676,7 +694,7 @@ instance ( AllNullary (a :+: b) allNullary

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

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

678696 gToEncoding opts pa te tel

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

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

680698 . sumToEncoding opts pa te tel

681699

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

@@ -728,7 +746,7 @@ nonAllNullarySumToJSON opts pa tj tjl =

728746class SumToEncoding arity f allNullary where

729747 sumToEncoding :: Options -> Proxy arity

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

731− -> f a -> Tagged allNullary Encoding

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

732750

733751instance ( GetConName f

734752 , TaggedObjectEnc arity f

@@ -822,29 +840,28 @@ instance ( IsRecord a isRecord

822840 , Constructor c

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

824842 taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =

825− E.openCurly <>

826− (toEncoding tagFieldName <>

827− E.colon <>

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

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

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

831− E.closeCurly

843+ E.wrapObject $

844+ (E.string tagFieldName ><

845+ E.colon ><

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

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

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

832849

833850class TaggedObjectEnc' arity f isRecord where

834851 taggedObjectEnc' :: Options -> Proxy arity

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

836− -> f a -> Tagged isRecord Encoding

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

837854

838855instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where

839− taggedObjectEnc' _ _ _ _ _ _ = Tagged mempty

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

840857

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

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

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

843860 . recordToEncoding opts pa te tel

844861

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

846863 taggedObjectEnc' opts pa contentsFieldName te tel =

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

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

848865 gToEncoding opts pa te tel

849866

850867--------------------------------------------------------------------------------

@@ -946,13 +963,13 @@ class ConsToEncoding' arity f isRecord where

946963 consToEncoding' :: Options -> Proxy arity

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

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

949− -> f a -> Tagged isRecord Encoding

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

950967

951968instance ( IsRecord f isRecord

952969 , ConsToEncoding' arity f isRecord

953970 ) => ConsToEncoding arity f where

954971 consToEncoding opts pa te tel =

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

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

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

957974

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

@@ -1003,39 +1020,40 @@ class RecordToEncoding arity f where

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

10041021 recordToEncoding :: Options -> Proxy arity

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

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

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

10071024

10081025instance ( RecordToEncoding arity a

10091026 , RecordToEncoding arity b

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

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

1012− (mconcat $ intersperse E.comma $

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

10131030 filter (not . E.nullEncoding)

10141031 [ fst (recordToEncoding opts pa te tel a)

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

10161033 , Nothing)

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

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

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

10191036 fst (recordToEncoding opts pa te tel b),

10201037 Nothing)

10211038

1039+

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

10231041 recordToEncoding = fieldToEncoding

10241042

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

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

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

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

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

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

10301048

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

10321050 => Options -> Proxy arity

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

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

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

10351053fieldToEncoding opts pa te tel m1 =

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

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

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

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

10391057

10401058--------------------------------------------------------------------------------

10411059

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

10701088class EncodeProduct arity f where

10711089 encodeProduct :: Options -> Proxy arity

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

1073− -> f a -> Encoding

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

10741092

10751093instance ( EncodeProduct arity a

10761094 , EncodeProduct arity b

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

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

1079− mconcat $ intersperse E.comma $

1097+ E.econcat $ intersperse E.comma $

10801098 filter (not . E.nullEncoding)

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

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

1083− E.comma <>

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

10841101 encodeProduct opts pa te tel b

10851102

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

1087− encodeProduct opts = gToEncoding opts

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

10881105

10891106--------------------------------------------------------------------------------

10901107

@@ -1130,12 +1147,12 @@ instance ( GToEncoding arity a

11301147 , Constructor c

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

11321149 objectWithSingleFieldEnc opts pa te tel v =

1133− E.openCurly <>

1150+ E.openCurly ><

11341151 toEncoding

11351152 (constructorTagModifier opts

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

1137− E.colon <>

1138− gToEncoding opts pa te tel v <>

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

1154+ E.colon ><

1155+ gToEncoding opts pa te tel v ><

11391156 E.closeCurly

11401157

11411158-------------------------------------------------------------------------------

@@ -1237,10 +1254,7 @@ instance ToJSON Bool where

12371254 {-# INLINE toEncoding #-}

12381255

12391256instance ToJSONKey Bool where

1240− toJSONKey = ToJSONKeyText

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

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

1243− )

1257+ toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"

12441258

12451259

12461260instance ToJSON Ordering where

@@ -1485,9 +1499,10 @@ instance ToJSON Text where

14851499 {-# INLINE toEncoding #-}

14861500

14871501instance ToJSONKey Text where

1488− toJSONKey = ToJSONKeyText (id, toEncoding)

1502+ toJSONKey = toJSONKeyText id

14891503 {-# INLINE toJSONKey #-}

14901504

1505+

14911506instance ToJSON LT.Text where

14921507 toJSON = String . LT.toStrict

14931508 {-# INLINE toJSON #-}

@@ -1495,6 +1510,10 @@ instance ToJSON LT.Text where

14951510 toEncoding = E.lazyText

14961511 {-# INLINE toEncoding #-}

14971512

1513+instance ToJSONKey LT.Text where

1514+ toJSONKey = toJSONKeyText LT.toStrict

1515+

1516+

14981517instance ToJSON Version where

14991518 toJSON = toJSON . showVersion

15001519 {-# INLINE toJSON #-}

@@ -1502,6 +1521,9 @@ instance ToJSON Version where

15021521 toEncoding = toEncoding . showVersion

15031522 {-# INLINE toEncoding #-}

15041523

1524+instance ToJSONKey Version where

1525+ toJSONKey = toJSONKeyText (T.pack . showVersion)

1526+

15051527-------------------------------------------------------------------------------

15061528-- semigroups NonEmpty

15071529-------------------------------------------------------------------------------

@@ -1617,14 +1639,14 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where

16171639

16181640instance ToJSONKey k => ToJSON1 (M.Map k) where

16191641 liftToJSON g _ = case toJSONKey of

1620− ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g

1621− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList

1642+ ToJSONKeyText f _ -> Object . mapHashKeyVal f g

1643+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList

16221644 {-# INLINE liftToJSON #-}

16231645

16241646 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding

16251647 liftToEncoding g _ = case toJSONKey of

1626− ToJSONKeyText (_,f) -> dict f g M.foldrWithKey

1627− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList

1648+ ToJSONKeyText _ f -> dict f g M.foldrWithKey

1649+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList

16281650 where

16291651 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding

16301652 pairEncoding f (a, b) = tuple $ f a >*< g b

@@ -1736,14 +1758,14 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where

17361758

17371759instance ToJSONKey k => ToJSON1 (H.HashMap k) where

17381760 liftToJSON g _ = case toJSONKey of

1739− ToJSONKeyText (f,_) -> Object . mapKeyVal f g

1740− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList

1761+ ToJSONKeyText f _ -> Object . mapKeyVal f g

1762+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList

17411763 {-# INLINE liftToJSON #-}

17421764

17431765 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding

17441766 liftToEncoding g _ = case toJSONKey of

1745− ToJSONKeyText (_,f) -> dict f g H.foldrWithKey

1746− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList

1767+ ToJSONKeyText _ f -> dict f g H.foldrWithKey

1768+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList

17471769 where

17481770 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding

17491771 pairEncoding f (a, b) = tuple $ f a >*< g b

@@ -1823,13 +1845,12 @@ instance ToJSONKey UTCTime where

18231845 toJSONKey = toJSONKeyTextEnc E.utcTime

18241846

18251847-- | Encode something t a JSON string.

1826−stringEncoding :: Encoding -> Value

1848+stringEncoding :: Encoding' Text -> Value

18271849stringEncoding = String

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

18291851 . T.decodeLatin1

18301852 . L.toStrict

1831− . B.toLazyByteString

1832− . fromEncoding

1853+ . E.encodingToLazyByteString

18331854{-# INLINE stringEncoding #-}

18341855

18351856instance ToJSON NominalDiffTime where

@@ -1922,22 +1943,13 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where

19221943-- Instances for converting t map keys

19231944-------------------------------------------------------------------------------

19241945

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

1926−-- export and document this function from there

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

1928−toJSONKeyTextEnc e = ToJSONKeyText

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

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

1931− , e

1932− )

1933−

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

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

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

19371949

19381950instance ToJSONKey Char where

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

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

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

1952+ toJSONKeyList = toJSONKeyText T.pack

19411953

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

19431955 toJSONKey = toJSONKeyList

aeson.cabal+12−7

@@ -63,18 +63,23 @@ library

6363

6464 exposed-modules:

6565 Data.Aeson

66− Data.Aeson.Encode

6766 Data.Aeson.Encoding

68− Data.Aeson.Encoding.Internal

69− Data.Aeson.Internal

70− Data.Aeson.Internal.Time

7167 Data.Aeson.Parser

68+ Data.Aeson.Text

7269 Data.Aeson.Types

7370 Data.Aeson.TH

7471

72+ Data.Aeson.Encoding.Internal

73+ Data.Aeson.Internal

74+ Data.Aeson.Internal.Time

75+

76+ -- Deprecated modules

77+ exposed-modules:

78+ Data.Aeson.Encode

79+

7580 other-modules:

76− Data.Aeson.Encode.Builder

77− Data.Aeson.Functions

81+ Data.Aeson.Encoding.Builder

82+ Data.Aeson.Internal.Functions

7883 Data.Aeson.Parser.Internal

7984 Data.Aeson.Parser.Time

8085 Data.Aeson.Types.FromJSON

@@ -155,7 +160,7 @@ test-suite tests

155160 dlist,

156161 generic-deriving >= 1.10 && < 1.11,

157162 ghc-prim >= 0.2,

158− hashable >= 1.1.2.0,

163+ hashable >= 1.2.4.0,

159164 tagged,

160165 template-haskell,

161166 test-framework,

benchmarks/CompareWithJSON.hs+1−1

@@ -4,8 +4,8 @@ import Blaze.ByteString.Builder (toLazyByteString)

44import Blaze.ByteString.Builder.Char.Utf8 (fromString)

55import Control.DeepSeq (NFData(rnf))

66import Criterion.Main

7−import qualified Data.Aeson.Encode as A

87import qualified Data.Aeson as A

8+import qualified Data.Aeson.Text as A

99import qualified Data.ByteString.Lazy as BL

1010import qualified Text.JSON as J

1111import qualified Data.Text.Lazy as TL

benchmarks/Micro.hs+1−1

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

11module Main (main) where

33import Criterion.Main

4−import qualified Data.Aeson.Encode.Builder as AB

4+import qualified Data.Aeson.Encoding.Builder as AB

55import qualified Data.ByteString.Builder as B

66import qualified Data.Text as T

benchmarks/aeson-benchmarks.cabal+7−6

@@ -9,17 +9,18 @@ library

1010 exposed-modules:

1111 Data.Aeson

12− Data.Aeson.Encode

1312 Data.Aeson.Encoding

14− Data.Aeson.Encoding.Internal

15− Data.Aeson.Internal

16− Data.Aeson.Internal.Time

1713 Data.Aeson.Parser

14+ Data.Aeson.Text

1815 Data.Aeson.Types

1916 Data.Aeson.TH

2017

21− Data.Aeson.Encode.Builder

22− Data.Aeson.Functions

18+ Data.Aeson.Encoding.Internal

19+ Data.Aeson.Internal

20+ Data.Aeson.Internal.Time

21+

22+ Data.Aeson.Encoding.Builder

23+ Data.Aeson.Internal.Functions

2324 Data.Aeson.Parser.Internal

2425 Data.Aeson.Parser.Time

2526 Data.Aeson.Types.FromJSON

tests/Properties.hs+5−2

@@ -6,8 +6,7 @@ import Prelude ()

66import Prelude.Compat

88import Control.Applicative (Const)

9−import Data.Aeson (eitherDecode)

10−import Data.Aeson.Encode (encode)

9+import Data.Aeson (eitherDecode, encode)

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

1211import Data.Aeson.Parser (value)

1312import Data.Aeson.Types

@@ -37,6 +36,7 @@ import qualified Data.ByteString.Lazy.Char8 as L

3736import qualified Data.HashMap.Strict as H

3837import qualified Data.Map as Map

3938import qualified Data.Text as T

39+import qualified Data.Text.Lazy as LT

4040import qualified Data.Vector as V

4141

4242encodeDouble :: Double -> Double -> Property

@@ -151,6 +151,7 @@ tests = testGroup "properties" [

151151 , testProperty "Integer" $ roundTripEq (1 :: Integer)

152152 , testProperty "String" $ roundTripEq ("" :: String)

153153 , testProperty "Text" $ roundTripEq T.empty

154+ , testProperty "Lazy Text" $ roundTripEq LT.empty

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

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

156157 , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)

@@ -192,6 +193,8 @@ tests = testGroup "properties" [

192193 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)

193194 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)

194195#endif

196+ , testProperty "Version" $ roundTripKey (undefined :: Version)

197+ , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)

195198 ]

196199 , testGroup "toFromJSON" [

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

tests/UnitTests.hs+1−2

@@ -13,7 +13,7 @@ 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.Encode (encodeToTextBuilder)

16+import Data.Aeson.Text (encodeToTextBuilder)

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

1818import Data.Aeson.TH (deriveJSON)

1919import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)

@@ -322,7 +322,6 @@ fromJSONKeyAssertions =

322322 , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))

323323 , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)

324324

325−-- Why this doesn't work on older GHC?

326325#if __GLASGOW_HASKELL__ >= 710

327326 , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')

328327#endif