git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #412 from phadej/abstract-encoding-2
26a4bfbAdam Bergmark
Data/Aeson/Encode.hs+12−2
compare with master
unifiedsplit
@@ -28,16 +28,26 @@ module Data.Aeson.Encode
28 ) where
28 ) where
29
29
30import Data.Aeson.Encode.Builder (encodeToBuilder)
30import Data.Aeson.Encode.Builder (encodeToBuilder)
31−import Data.Aeson.Encode.Functions (encode)
31+import Data.Aeson.Types (Value(..), ToJSON (..))
32−import Data.Aeson.Types (Value(..))
32+import Data.Aeson.Encoding (fromEncoding)
33import Data.Monoid ((<>))
33import Data.Monoid ((<>))
34import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
34import Data.Scientific (FPFormat(..), Scientific, base10Exponent)
35import Data.Text.Lazy.Builder
35import Data.Text.Lazy.Builder
36import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
36import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder)
37+
37import Numeric (showHex)
38import Numeric (showHex)
39+import qualified Data.ByteString.Builder as B
38import qualified Data.HashMap.Strict as H
40import qualified Data.HashMap.Strict as H
39import qualified Data.Text as T
41import qualified Data.Text as T
40import qualified Data.Vector as V
42import 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 #-}
41
51
42-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
52-- | Encode a JSON 'Value' to a "Data.Text" 'Builder', which can be
43-- embedded efficiently in a text-based protocol.
53-- embedded efficiently in a text-based protocol.
Data/Aeson/Encode/Builder.hs+8−14
@@ -36,7 +36,7 @@ module Data.Aeson.Encode.Builder
36 ) where
36 ) where
37
37
38import Data.Aeson.Internal.Time
38import Data.Aeson.Internal.Time
39−import Data.Aeson.Types.Internal (Encoding(..), Value(..))
39+import Data.Aeson.Types.Internal (Value (..))
40import Data.ByteString.Builder as B
40import Data.ByteString.Builder as B
41import Data.ByteString.Builder.Prim as BP
41import Data.ByteString.Builder.Prim as BP
42import Data.ByteString.Builder.Scientific (scientificBuilder)
42import Data.ByteString.Builder.Scientific (scientificBuilder)
@@ -76,7 +76,7 @@ bool = BP.primBounded (BP.condB id (ascii4 ('t',('r',('u','e'))))
76-- | Encode a JSON array.
76-- | Encode a JSON array.
77array :: V.Vector Value -> Builder
77array :: V.Vector Value -> Builder
78array v
78array v
79− | V.null v = emptyArray__
79+ | V.null v = emptyArray_
80 | otherwise = B.char8 '[' <>
80 | otherwise = B.char8 '[' <>
81 encodeToBuilder (V.unsafeHead v) <>
81 encodeToBuilder (V.unsafeHead v) <>
82 V.foldr withComma (B.char8 ']') (V.unsafeTail v)
82 V.foldr withComma (B.char8 ']') (V.unsafeTail v)
@@ -87,7 +87,7 @@ array v
87object :: HMS.HashMap T.Text Value -> Builder
87object :: HMS.HashMap T.Text Value -> Builder
88object m = case HMS.toList m of
88object m = case HMS.toList m of
89 (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
89 (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs
90− _ -> emptyObject__
90+ _ -> emptyObject_
91 where
91 where
92 withComma a z = B.char8 ',' <> one a <> z
92 withComma a z = B.char8 ',' <> one a <> z
93 one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
93 one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
@@ -98,7 +98,7 @@ text t = B.char8 '"' <> unquoted t <> B.char8 '"'
98
98
99-- | Encode a JSON string, without enclosing quotes.
99-- | Encode a JSON string, without enclosing quotes.
100unquoted :: T.Text -> Builder
100unquoted :: T.Text -> Builder
101−unquoted t = TE.encodeUtf8BuilderEscaped escapeAscii t
101+unquoted = TE.encodeUtf8BuilderEscaped escapeAscii
102
102
103-- | Add quotes surrounding a builder
103-- | Add quotes surrounding a builder
104quote :: Builder -> Builder
104quote :: Builder -> Builder
@@ -135,17 +135,11 @@ number s
135 where
135 where
136 e = base10Exponent s
136 e = base10Exponent s
137
137
138−emptyArray_ :: Encoding
138+emptyArray_ :: Builder
139−emptyArray_ = Encoding emptyArray__
139+emptyArray_ = BP.primBounded (ascii2 ('[',']')) ()
140
140
141−emptyArray__ :: Builder
142−emptyArray__ = BP.primBounded (ascii2 ('[',']')) ()
143−
144−emptyObject_ :: Encoding
141+emptyObject_ :: Builder
145−emptyObject_ = Encoding emptyObject__
146−
147−emptyObject__ :: Builder
148−emptyObject__ = BP.primBounded (ascii2 ('{','}')) ()
142+emptyObject_ = BP.primBounded (ascii2 ('{','}')) ()
149
143
150ascii2 :: (Char, Char) -> BP.BoundedPrim a
144ascii2 :: (Char, Char) -> BP.BoundedPrim a
151ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 >*< BP.char7
145ascii2 cs = BP.liftFixedToBounded $ (const cs) BP.>$< BP.char7 >*< BP.char7
Data/Aeson/Encode/Functions.hs+3−67
@@ -2,78 +2,14 @@
2
2
3module Data.Aeson.Encode.Functions
3module Data.Aeson.Encode.Functions
4 (
4 (
5− brackets
6− , builder
7− , builder'
5+ builder
8− , char7
9− , encode
10− , list
11− , encodeMap
12− , encodeWithKey
13 ) where
6 ) where
14
7
15−import Data.Aeson.Encode.Builder
8+import Data.Aeson.Encoding
16import Data.Aeson.Types.Class
9import Data.Aeson.Types.Class
17−import Data.Aeson.Types.Internal
18−import Data.ByteString.Builder (Builder, char7)
10+import Data.ByteString.Builder (Builder)
19−import Data.ByteString.Builder.Prim (primBounded)
20−import Data.Foldable (toList)
21import Data.Monoid ((<>))
11import Data.Monoid ((<>))
22−import qualified Data.ByteString.Builder as B
23−import qualified Data.ByteString.Lazy as L
24−
25−#if !MIN_VERSION_base(4,8,0)
26−import Data.Foldable (Foldable, foldMap)
27−import Data.Monoid (mempty)
28−#endif
29−
30−list :: (a -> Encoding) -> [a] -> Encoding
31−list = listEncoding
32
12
33builder :: ToJSON a => a -> Builder
13builder :: ToJSON a => a -> Builder
34builder = fromEncoding . toEncoding
14builder = fromEncoding . toEncoding
35{-# INLINE builder #-}
15{-# INLINE builder #-}
36−
37−builder' :: (a -> Encoding) -> a -> Builder
38−builder' f = fromEncoding . f
39−{-# INLINE builder' #-}
40−
41−-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
42−--
43−-- This is implemented in terms of the 'ToJSON' class's 'toEncoding' method.
44−encode :: ToJSON a => a -> L.ByteString
45−encode = B.toLazyByteString . builder
46−{-# INLINE encode #-}
47−
48−brackets :: Char -> Char -> Series -> Encoding
49−brackets begin end (Value v) = Encoding $
50− char7 begin <> fromEncoding v <> char7 end
51−brackets begin end Empty = Encoding (primBounded (ascii2 (begin,end)) ())
52−
53−
54−
55−encodeMap :: (k -> Encoding)
56− -> (v -> Encoding)
57− -> (m -> Maybe ((k,v), m))
58− -> ((k -> v -> B.Builder -> B.Builder) -> B.Builder -> m -> B.Builder)
59− -> m -> Encoding
60−encodeMap encodeKey encodeVal minViewWithKey foldrWithKey xs =
61− case minViewWithKey xs of
62− Nothing -> Encoding $ primBounded (ascii2 ('{', '}')) ()
63− Just ((k,v),ys) -> Encoding $
64− B.char7 '{' <> encodeKV encodeKey encodeVal k v <>
65− foldrWithKey go (B.char7 '}') ys
66− where go k v b = B.char7 ',' <> encodeKV encodeKey encodeVal k v <> b
67−{-# INLINE encodeMap #-}
68−
69−encodeWithKey :: (k -> Encoding)
70− -> (v -> Encoding)
71− -> ((k -> v -> Series -> Series) -> Series -> m -> Series)
72− -> m -> Encoding
73−encodeWithKey encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
74− where go k v c = Value (Encoding $ encodeKV encodeKey encodeVal k v) <> c
75−{-# INLINE encodeWithKey #-}
76−
77−encodeKV :: (k -> Encoding) -> (v -> Encoding) -> k -> v -> B.Builder
78−encodeKV encodeKey encodeVal k v = fromEncoding (encodeKey k) <> B.char7 ':' <> builder' encodeVal v
79−{-# INLINE encodeKV #-}
Data/Aeson/Encoding.hsnew file+19
@@ -0,0 +1,19 @@
1+module Data.Aeson.Encoding
2+ (
3+ -- * Encoding
4+ Encoding
5+ , fromEncoding
6+ , unsafeToEncoding
7+ , Series
8+ , pairs
9+ -- * Predicates
10+ , nullEncoding
11+ -- * Encoding constructors
12+ , emptyArray_
13+ , emptyObject_
14+ , text
15+ , list
16+ , dict
17+ ) where
18+
19+import Data.Aeson.Encoding.Internal
Data/Aeson/Encoding/Internal.hsnew file+166
@@ -0,0 +1,166 @@
1+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable, RankNTypes #-}
2+module Data.Aeson.Encoding.Internal
3+ (
4+ -- * Encoding
5+ Encoding (..) -- TODO: export fromEncoding for now
6+ , fromEncoding
7+ , unsafeToEncoding
8+ , Series (..) -- TODO: don't export constructor
9+ , pairs
10+ -- * Predicates
11+ , nullEncoding
12+ -- * Encoding constructors
13+ , emptyArray_
14+ , emptyObject_
15+ , wrapArray
16+ , wrapObject
17+ , text
18+ , list
19+ , dict
20+ , tuple
21+ , (>*<)
22+ -- ** chars
23+ , comma, colon, openBracket, closeBracket, openCurly, closeCurly
24+ ) where
25+
26+#if !MIN_VERSION_base(4,8,0)
27+import Data.Monoid (Monoid(..))
28+#endif
29+
30+import Data.Text (Text)
31+import Data.ByteString.Builder (Builder, char7, toLazyByteString)
32+import Data.Semigroup (Semigroup((<>)))
33+import Data.ByteString.Builder.Prim (primBounded)
34+import Data.Typeable (Typeable)
35+
36+import qualified Data.ByteString.Lazy as BSL
37+import qualified Data.Aeson.Encode.Builder as B
38+
39+-- | An encoding of a JSON value.
40+newtype Encoding = Encoding {
41+ fromEncoding :: Builder
42+ -- ^ Acquire the underlying bytestring builder.
43+ } deriving (Semigroup,Monoid,Typeable)
44+
45+-- | Make Encoding from Builder.
46+--
47+-- Use with care! You have to make sure that the passed Builder
48+-- is a valid JSON Encoding!
49+unsafeToEncoding :: Builder -> Encoding
50+unsafeToEncoding = Encoding
51+
52+-------------------------------------------------------------------------------
53+-- Encoding instances
54+-------------------------------------------------------------------------------
55+
56+instance Show Encoding where
57+ show (Encoding e) = show (toLazyByteString e)
58+
59+instance Eq Encoding where
60+ Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
61+
62+instance Ord Encoding where
63+ compare (Encoding a) (Encoding b) =
64+ compare (toLazyByteString a) (toLazyByteString b)
65+
66+-- | A series of values that, when encoded, should be separated by
67+-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
68+-- either @(Text, Value)@ or 'Series'. You can use Series when
69+-- encoding directly to a bytestring builder as in the following
70+-- example:
71+--
72+-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
73+data Series = Empty
74+ | Value Encoding
75+ deriving (Typeable)
76+
77+instance Semigroup Series where
78+ Empty <> a = a
79+ Value a <> b =
80+ Value $
81+ a <> case b of
82+ Empty -> mempty
83+ Value c -> Encoding (char7 ',') <> c
84+
85+instance Monoid Series where
86+ mempty = Empty
87+ mappend = (<>)
88+
89+nullEncoding :: Encoding -> Bool
90+nullEncoding = BSL.null . toLazyByteString . fromEncoding
91+
92+emptyArray_ :: Encoding
93+emptyArray_ = Encoding B.emptyArray_
94+
95+emptyObject_ :: Encoding
96+emptyObject_ = Encoding B.emptyObject_
97+
98+wrapArray :: Encoding -> Encoding
99+wrapArray e = openBracket <> e <> closeBracket
100+
101+wrapObject :: Encoding -> Encoding
102+wrapObject e = openCurly <> e <> closeCurly
103+
104+-- | Encode a series of key/value pairs, separated by commas.
105+pairs :: Series -> Encoding
106+pairs = brackets '{' '}'
107+{-# INLINE pairs #-}
108+
109+brackets :: Char -> Char -> Series -> Encoding
110+brackets begin end (Value v) = Encoding $
111+ char7 begin <> fromEncoding v <> char7 end
112+brackets begin end Empty = Encoding (primBounded (B.ascii2 (begin,end)) ())
113+
114+list :: (a -> Encoding) -> [a] -> Encoding
115+list _ [] = emptyArray_
116+list to' (x:xs) = Encoding $
117+ char7 '[' <> fromEncoding (to' x) <> commas xs <> char7 ']'
118+ where
119+ commas = foldr (\v vs -> char7 ',' <> fromEncoding (to' v) <> vs) mempty
120+{-# INLINE list #-}
121+
122+-- | Encode as JSON object
123+dict
124+ :: (k -> Encoding) -- ^ key encoding
125+ -> (v -> Encoding) -- ^ value encoding
126+ -> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold
127+ -> m -- ^ container
128+ -> Encoding
129+dict encodeKey encodeVal foldrWithKey = brackets '{' '}' . foldrWithKey go mempty
130+ where
131+ go k v c = Value (encodeKV k v) <> c
132+ encodeKV k v = encodeKey k <> Encoding (char7 ':') <> encodeVal v
133+{-# INLINE dict #-}
134+
135+infixr 6 >*<
136+-- | See 'tuple'.
137+(>*<) :: Encoding -> Encoding -> Encoding
138+Encoding a >*< Encoding b = Encoding $ a <> char7 ',' <> b
139+{-# INLINE (>*<) #-}
140+
141+-- | Encode as a tuple.
142+--
143+-- @
144+-- toEncoding (X a b c) = tuple $
145+-- toEncoding a >*<
146+-- toEncoding b >*<
147+-- toEncoding c
148+tuple :: Encoding -> Encoding
149+tuple b = Encoding (char7 '[' <> fromEncoding b <> char7 ']')
150+{-# INLINE tuple #-}
151+
152+text :: Text -> Encoding
153+text = Encoding . B.text
154+
155+-------------------------------------------------------------------------------
156+-- chars
157+-------------------------------------------------------------------------------
158+
159+comma, colon, openBracket, closeBracket, openCurly, closeCurly :: Encoding
160+comma = Encoding $ char7 ','
161+colon = Encoding $ char7 ':'
162+openBracket = Encoding $ char7 '['
163+closeBracket = Encoding $ char7 ']'
164+openCurly = Encoding $ char7 '{'
165+closeCurly = Encoding $ char7 '}'
166+
Data/Aeson/TH.hs+15−16
@@ -107,7 +107,7 @@ import Data.Aeson.Types ( Value(..), Parser
107 , defaultOptions
107 , defaultOptions
108 , defaultTaggedObject
108 , defaultTaggedObject
109 )
109 )
110−import Data.Aeson.Types.Internal (Encoding(..), (<?>), JSONPathElement(Key))
110+import Data.Aeson.Types.Internal ((<?>), JSONPathElement(Key))
111import Control.Monad ( liftM2, return, mapM, fail )
111import Control.Monad ( liftM2, return, mapM, fail )
112import Data.Bool ( Bool(False, True), otherwise, (&&), not )
112import Data.Bool ( Bool(False, True), otherwise, (&&), not )
113import Data.Either ( Either(Left, Right) )
113import Data.Either ( Either(Left, Right) )
@@ -140,8 +140,7 @@ import Prelude ( head )
140import Text.Printf ( printf )
140import Text.Printf ( printf )
141import Text.Show ( show )
141import Text.Show ( show )
142import qualified Data.Aeson as A
142import qualified Data.Aeson as A
143−import qualified Data.Aeson.Encode.Builder as E
143+import qualified Data.Aeson.Encoding.Internal as E
144−import qualified Data.Aeson.Encode.Functions as E
145import qualified Data.HashMap.Strict as H ( lookup, toList )
144import qualified Data.HashMap.Strict as H ( lookup, toList )
146import qualified Data.Map as M ( fromList, findWithDefault )
145import qualified Data.Map as M ( fromList, findWithDefault )
147import qualified Data.Text as T ( Text, pack, unpack )
146import qualified Data.Text as T ( Text, pack, unpack )
@@ -291,7 +290,7 @@ consToEncoding opts cons = do
291 matches
290 matches
292 | allNullaryToStringTag opts && all isNullary cons =
291 | allNullaryToStringTag opts && all isNullary cons =
293 [ match (conP conName [])
292 [ match (conP conName [])
294− (normalB $ [|Encoding|] `appE` encStr opts conName) []
293+ (normalB $ encStr opts conName) []
295 | con <- cons
294 | con <- cons
296 , let conName = getConName con
295 , let conName = getConName con
297 ]
296 ]
@@ -458,23 +457,23 @@ isMaybe _ = False
458infixr 6 <^>
457infixr 6 <^>
459
458
460(<:>) :: ExpQ -> ExpQ -> ExpQ
459(<:>) :: ExpQ -> ExpQ -> ExpQ
461−(<:>) a b = a <^> [|E.char7 ':'|] <^> b
460+(<:>) a b = a <^> [|E.colon|] <^> b
462infixr 5 <:>
461infixr 5 <:>
463
462
464(<%>) :: ExpQ -> ExpQ -> ExpQ
463(<%>) :: ExpQ -> ExpQ -> ExpQ
465−(<%>) a b = a <^> [|E.char7 ','|] <^> b
464+(<%>) a b = a <^> [|E.comma|] <^> b
466infixr 4 <%>
465infixr 4 <%>
467
466
468array :: ExpQ -> ExpQ
467array :: ExpQ -> ExpQ
469−array exp = [|Encoding|] `appE` ([|E.char7 '['|] <^> exp <^> [|E.char7 ']'|])
468+array exp = [|E.wrapArray|] `appE` exp
470
469
471object :: ExpQ -> ExpQ
470object :: ExpQ -> ExpQ
472−object exp = [|Encoding|] `appE` ([|E.char7 '{'|] <^> exp <^> [|E.char7 '}'|])
471+object exp = [|E.wrapObject|] `appE` exp
473
472
474sumToEncoding :: Options -> Bool -> Name -> Q Exp -> Q Exp
473sumToEncoding :: Options -> Bool -> Name -> Q Exp -> Q Exp
475sumToEncoding opts multiCons conName exp
474sumToEncoding opts multiCons conName exp
476 | multiCons =
475 | multiCons =
477− let fexp = [|fromEncoding|] `appE` exp in
476+ let fexp = exp in
478 case sumEncoding opts of
477 case sumEncoding opts of
479 TwoElemArray ->
478 TwoElemArray ->
480 array (encStr opts conName <%> fexp)
479 array (encStr opts conName <%> fexp)
@@ -514,7 +513,7 @@ argsToEncoding opts multiCons (NormalC conName ts) = do
514 [e] -> return ([|toEncoding|] `appE` varE e)
513 [e] -> return ([|toEncoding|] `appE` varE e)
515 -- Multiple arguments are converted to a JSON array.
514 -- Multiple arguments are converted to a JSON array.
516 es ->
515 es ->
517− return (array (foldr1 (<%>) [[|E.builder|] `appE` varE x | x <- es]))
516+ return (array (foldr1 (<%>) [[|toEncoding|] `appE` varE x | x <- es]))
518 match (conP conName $ map varP args)
517 match (conP conName $ map varP args)
519 (normalB $ sumToEncoding opts multiCons conName js)
518 (normalB $ sumToEncoding opts multiCons conName js)
520 []
519 []
@@ -528,7 +527,7 @@ argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,
528 let exp = object objBody
527 let exp = object objBody
529
528
530 objBody = [|mconcat|] `appE`
529 objBody = [|mconcat|] `appE`
531− ([|intersperse (E.char7 ',')|] `appE` pairs)
530+ ([|intersperse E.comma|] `appE` pairs)
532 pairs | omitNothingFields opts = infixApp maybeFields
531 pairs | omitNothingFields opts = infixApp maybeFields
533 [|(<>)|]
532 [|(<>)|]
534 restFields
533 restFields
@@ -546,16 +545,16 @@ argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,
546 infixApp
545 infixApp
547 (infixApp
546 (infixApp
548 (infixE
547 (infixE
549− (Just $ toFieldName field <^> [|E.char7 ':'|])
548+ (Just $ toFieldName field <^> [|E.colon|])
550 [|(<>)|]
549 [|(<>)|]
551 Nothing)
550 Nothing)
552 [|(.)|]
551 [|(.)|]
553− [|E.builder|])
552+ [|toEncoding|])
554 [|(<$>)|]
553 [|(<$>)|]
555 (varE arg)
554 (varE arg)
556
555
557 toPair (arg, (field, _, _)) =
556 toPair (arg, (field, _, _)) =
558− toFieldName field <:> [|E.builder|] `appE` varE arg
557+ toFieldName field <:> [|toEncoding|] `appE` varE arg
559
558
560 toFieldName field = [|E.text|] `appE`
559 toFieldName field = [|E.text|] `appE`
561 ([|T.pack|] `appE` fieldLabelExp opts field)
560 ([|T.pack|] `appE` fieldLabelExp opts field)
@@ -565,13 +564,13 @@ argsToEncoding opts multiCons (RecC conName ts) = case (unwrapUnaryRecords opts,
565 $ if multiCons
564 $ if multiCons
566 then case sumEncoding opts of
565 then case sumEncoding opts of
567 TwoElemArray -> array $
566 TwoElemArray -> array $
568− encStr opts conName <%> [|fromEncoding|] `appE` exp
567+ encStr opts conName <%> exp
569 TaggedObject{tagFieldName} -> object $
568 TaggedObject{tagFieldName} -> object $
570 ([|E.text (T.pack tagFieldName)|] <:>
569 ([|E.text (T.pack tagFieldName)|] <:>
571 encStr opts conName) <%>
570 encStr opts conName) <%>
572 objBody
571 objBody
573 ObjectWithSingleField -> object $
572 ObjectWithSingleField -> object $
574− encStr opts conName <:> [|fromEncoding|] `appE` exp
573+ encStr opts conName <:> exp
575 else exp
574 else exp
576 ) []
575 ) []
577
576
Data/Aeson/Types.hs+1−6
@@ -97,16 +97,11 @@ module Data.Aeson.Types
97import Data.Aeson.Types.Generic ()
97import Data.Aeson.Types.Generic ()
98import Data.Aeson.Types.Instances
98import Data.Aeson.Types.Instances
99import Data.Aeson.Types.Internal
99import Data.Aeson.Types.Internal
100+import Data.Aeson.Encoding (Encoding, unsafeToEncoding, fromEncoding, Series, pairs)
100
101
101import Data.Foldable (Foldable, toList)
102import Data.Foldable (Foldable, toList)
102−import Data.Aeson.Encode.Functions (brackets)
103
103
104-- | Encode a 'Foldable' as a JSON array.
104-- | Encode a 'Foldable' as a JSON array.
105foldable :: (Foldable t, ToJSON a) => t a -> Encoding
105foldable :: (Foldable t, ToJSON a) => t a -> Encoding
106foldable = toEncoding . toList
106foldable = toEncoding . toList
107{-# INLINE foldable #-}
107{-# INLINE foldable #-}
108−
109−-- | Encode a series of key/value pairs, separated by commas.
110−pairs :: Series -> Encoding
111−pairs = brackets '{' '}'
112−{-# INLINE pairs #-}
Data/Aeson/Types/Class.hs+16−17
@@ -1,5 +1,5 @@
1−{-# LANGUAGE CPP, GADTs, DefaultSignatures, FlexibleContexts, DeriveFunctor,
1+{-# LANGUAGE CPP, GADTs, DefaultSignatures, FlexibleInstances, FlexibleContexts, DeriveFunctor,
2− ScopedTypeVariables #-}
2+ ScopedTypeVariables, TypeSynonymInstances #-}
3
3
4-- |
4-- |
5-- Module: Data.Aeson.Types.Class
5-- Module: Data.Aeson.Types.Class
@@ -55,12 +55,12 @@ module Data.Aeson.Types.Class
55 ) where
55 ) where
56
56
57import Data.Aeson.Types.Internal
57import Data.Aeson.Types.Internal
58+import Data.Aeson.Encoding.Internal (Encoding, Series)
58import Data.Monoid ((<>))
59import Data.Monoid ((<>))
59import Data.Text (Text)
60import Data.Text (Text)
60import GHC.Generics (Generic, Rep, from, to)
61import GHC.Generics (Generic, Rep, from, to)
61−import Data.Aeson.Encode.Builder (emptyArray_)
62−import qualified Data.ByteString.Builder as B
63−import qualified Data.Aeson.Encode.Builder as E
62+import qualified Data.Aeson.Encoding.Internal as E
63+import qualified Data.Aeson.Encode.Builder as EB
64import qualified Data.Vector as V
64import qualified Data.Vector as V
65
65
66#if !MIN_VERSION_base(4,8,0)
66#if !MIN_VERSION_base(4,8,0)
@@ -208,7 +208,7 @@ class ToJSON a where
208 -- @
208 -- @
209
209
210 toEncoding :: a -> Encoding
210 toEncoding :: a -> Encoding
211− toEncoding = Encoding . E.encodeToBuilder . toJSON
211+ toEncoding = E.Encoding . EB.encodeToBuilder . toJSON
212 {-# INLINE toEncoding #-}
212 {-# INLINE toEncoding #-}
213
213
214 toJSONList :: [a] -> Value
214 toJSONList :: [a] -> Value
@@ -216,12 +216,7 @@ class ToJSON a where
216 {-# INLINE toJSONList #-}
216 {-# INLINE toJSONList #-}
217
217
218 toEncodingList :: [a] -> Encoding
218 toEncodingList :: [a] -> Encoding
219− toEncodingList [] = emptyArray_
219+ toEncodingList = listEncoding toEncoding
220− toEncodingList (x:xs) = Encoding $
221− B.char7 '[' <> builder x <> commas xs <> B.char7 ']'
222− where
223− commas = foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty
224− builder = fromEncoding . toEncoding
225 {-# INLINE toEncodingList #-}
220 {-# INLINE toEncodingList #-}
226
221
227-- | A type that can be converted from JSON, with the possibility of
222-- | A type that can be converted from JSON, with the possibility of
@@ -325,6 +320,14 @@ class KeyValue kv where
325 (.=) :: ToJSON v => Text -> v -> kv
320 (.=) :: ToJSON v => Text -> v -> kv
326 infixr 8 .=
321 infixr 8 .=
327
322
323+instance KeyValue Series where
324+ name .= value = E.Value $ E.text name <> E.colon <> toEncoding value
325+ {-# INLINE (.=) #-}
326+
327+instance KeyValue Pair where
328+ name .= value = (name, toJSON value)
329+ {-# INLINE (.=) #-}
330+
328-------------------------------------------------------------------------------
331-------------------------------------------------------------------------------
329-- Classes and types for map keys
332-- Classes and types for map keys
330-------------------------------------------------------------------------------
333-------------------------------------------------------------------------------
@@ -525,11 +528,7 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
525-------------------------------------------------------------------------------
528-------------------------------------------------------------------------------
526
529
527listEncoding :: (a -> Encoding) -> [a] -> Encoding
530listEncoding :: (a -> Encoding) -> [a] -> Encoding
528−listEncoding _ [] = emptyArray_
531+listEncoding = E.list
529−listEncoding to' (x:xs) = Encoding $
530− B.char7 '[' <> fromEncoding (to' x) <> commas xs <> B.char7 ']'
531− where commas = foldr (\v vs -> B.char7 ',' <> fromEncoding (to' v) <> vs) mempty
532−{-# INLINE listEncoding #-}
533
532
534listValue :: (a -> Value) -> [a] -> Value
533listValue :: (a -> Value) -> [a] -> Value
535listValue f = Array . V.fromList . map f
534listValue f = Array . V.fromList . map f
Data/Aeson/Types/Generic.hs+52−57
@@ -24,13 +24,11 @@ module Data.Aeson.Types.Generic ( ) where
24import Control.Applicative ((<|>))
24import Control.Applicative ((<|>))
25import Control.Monad ((<=<))
25import Control.Monad ((<=<))
26import Control.Monad.ST (ST)
26import Control.Monad.ST (ST)
27−import Data.Aeson.Encode.Builder (emptyArray_)
27+import Data.Aeson.Encoding.Internal (Encoding, (>*<))
28−import Data.Aeson.Encode.Functions (builder)
28+import qualified Data.Aeson.Encoding.Internal as E
29import Data.Aeson.Types.Instances
29import Data.Aeson.Types.Instances
30import Data.Aeson.Types.Internal
30import Data.Aeson.Types.Internal
31import Data.Bits (unsafeShiftR)
31import Data.Bits (unsafeShiftR)
32−import Data.ByteString.Builder as B
33−import qualified Data.ByteString.Lazy as BSL (null)
34import Data.DList (DList, toList, empty)
32import Data.DList (DList, toList, empty)
35import Data.Maybe (fromMaybe)
33import Data.Maybe (fromMaybe)
36import Data.Monoid ((<>))
34import Data.Monoid ((<>))
@@ -101,28 +99,27 @@ instance (ToJSON a) => GToEncoding (K1 i a) where
101
99
102instance GToEncoding U1 where
100instance GToEncoding U1 where
103 -- Empty constructors are encoded to an empty array:
101 -- Empty constructors are encoded to an empty array:
104− gToEncoding _opts _ = emptyArray_
102+ gToEncoding _opts _ = E.emptyArray_
105
103
106instance (ConsToEncoding a) => GToEncoding (C1 c a) where
104instance (ConsToEncoding a) => GToEncoding (C1 c a) where
107 -- Constructors need to be encoded differently depending on whether they're
105 -- Constructors need to be encoded differently depending on whether they're
108 -- a record or not. This distinction is made by 'consToEncoding':
106 -- a record or not. This distinction is made by 'consToEncoding':
109− gToEncoding opts = Encoding . consToEncoding opts . unM1
107+ gToEncoding opts = consToEncoding opts . unM1
110
108
111instance ( EncodeProduct a, EncodeProduct b ) => GToEncoding (a :*: b) where
109instance ( EncodeProduct a, EncodeProduct b ) => GToEncoding (a :*: b) where
112 -- Products are encoded to an array. Here we allocate a mutable vector of
110 -- Products are encoded to an array. Here we allocate a mutable vector of
113 -- the same size as the product and write the product's elements to it using
111 -- the same size as the product and write the product's elements to it using
114 -- 'encodeProduct':
112 -- 'encodeProduct':
115− gToEncoding opts p = Encoding $
116− B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
113+ gToEncoding opts p = E.tuple $ encodeProduct opts p
117
114
118instance ( AllNullary (a :+: b) allNullary
115instance ( AllNullary (a :+: b) allNullary
119 , SumToEncoding (a :+: b) allNullary ) => GToEncoding (a :+: b) where
116 , SumToEncoding (a :+: b) allNullary ) => GToEncoding (a :+: b) where
120 -- If all constructors of a sum datatype are nullary and the
117 -- If all constructors of a sum datatype are nullary and the
121 -- 'allNullaryToStringTag' option is set they are encoded to
118 -- 'allNullaryToStringTag' option is set they are encoded to
122 -- strings. This distinction is made by 'sumToEncoding':
119 -- strings. This distinction is made by 'sumToEncoding':
123− gToEncoding opts = Encoding .
120+ gToEncoding opts
124− (unTagged :: Tagged allNullary B.Builder -> B.Builder) .
121+ = (unTagged :: Tagged allNullary Encoding -> Encoding)
125− sumToEncoding opts
122+ . sumToEncoding opts
126
123
127--------------------------------------------------------------------------------
124--------------------------------------------------------------------------------
128
125
@@ -157,14 +154,14 @@ nonAllNullarySumToJSON opts =
157--------------------------------------------------------------------------------
154--------------------------------------------------------------------------------
158
155
159class SumToEncoding f allNullary where
156class SumToEncoding f allNullary where
160− sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
157+ sumToEncoding :: Options -> f a -> Tagged allNullary Encoding
161
158
162instance ( GetConName f
159instance ( GetConName f
163 , TaggedObjectEnc f
160 , TaggedObjectEnc f
164 , ObjectWithSingleFieldEnc f
161 , ObjectWithSingleFieldEnc f
165 , TwoElemArrayEnc f ) => SumToEncoding f True where
162 , TwoElemArrayEnc f ) => SumToEncoding f True where
166 sumToEncoding opts
163 sumToEncoding opts
167− | allNullaryToStringTag opts = Tagged . builder .
164+ | allNullaryToStringTag opts = Tagged . toEncoding .
168 constructorTagModifier opts . getConName
165 constructorTagModifier opts . getConName
169 | otherwise = Tagged . nonAllNullarySumToEncoding opts
166 | otherwise = Tagged . nonAllNullarySumToEncoding opts
170
167
@@ -176,7 +173,7 @@ instance ( TwoElemArrayEnc f
176nonAllNullarySumToEncoding :: ( TwoElemArrayEnc f
173nonAllNullarySumToEncoding :: ( TwoElemArrayEnc f
177 , TaggedObjectEnc f
174 , TaggedObjectEnc f
178 , ObjectWithSingleFieldEnc f
175 , ObjectWithSingleFieldEnc f
179− ) => Options -> f a -> B.Builder
176+ ) => Options -> f a -> Encoding
180nonAllNullarySumToEncoding opts =
177nonAllNullarySumToEncoding opts =
181 case sumEncoding opts of
178 case sumEncoding opts of
182 TaggedObject{..} ->
179 TaggedObject{..} ->
@@ -221,7 +218,7 @@ instance (GToJSON f) => TaggedObjectPairs' f False where
221--------------------------------------------------------------------------------
218--------------------------------------------------------------------------------
222
219
223class TaggedObjectEnc f where
220class TaggedObjectEnc f where
224− taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
221+ taggedObjectEnc :: Options -> String -> String -> f a -> Encoding
225
222
226instance ( TaggedObjectEnc a
223instance ( TaggedObjectEnc a
227 , TaggedObjectEnc b ) => TaggedObjectEnc (a :+: b) where
224 , TaggedObjectEnc b ) => TaggedObjectEnc (a :+: b) where
@@ -234,27 +231,27 @@ instance ( IsRecord a isRecord
234 , TaggedObjectEnc' a isRecord
231 , TaggedObjectEnc' a isRecord
235 , Constructor c ) => TaggedObjectEnc (C1 c a) where
232 , Constructor c ) => TaggedObjectEnc (C1 c a) where
236 taggedObjectEnc opts tagFieldName contentsFieldName v =
233 taggedObjectEnc opts tagFieldName contentsFieldName v =
237− B.char7 '{' <>
234+ E.openCurly <>
238− (builder tagFieldName <>
235+ (toEncoding tagFieldName <>
239− B.char7 ':' <>
236+ E.colon <>
240− builder (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
237+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
241− ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .
238+ ((unTagged :: Tagged isRecord Encoding -> Encoding) .
242 taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
239 taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
243− B.char7 '}'
240+ E.closeCurly
244
241
245class TaggedObjectEnc' f isRecord where
242class TaggedObjectEnc' f isRecord where
246− taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder
243+ taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord Encoding
247
244
248instance OVERLAPPING_ TaggedObjectEnc' U1 False where
245instance OVERLAPPING_ TaggedObjectEnc' U1 False where
249 taggedObjectEnc' _ _ _ = Tagged mempty
246 taggedObjectEnc' _ _ _ = Tagged mempty
250
247
251instance (RecordToEncoding f) => TaggedObjectEnc' f True where
248instance (RecordToEncoding f) => TaggedObjectEnc' f True where
252− taggedObjectEnc' opts _ = Tagged . (B.char7 ',' <>) . fst . recordToEncoding opts
249+ taggedObjectEnc' opts _ = Tagged . (E.comma <>) . fst . recordToEncoding opts
253
250
254instance (GToEncoding f) => TaggedObjectEnc' f False where
251instance (GToEncoding f) => TaggedObjectEnc' f False where
255 taggedObjectEnc' opts contentsFieldName =
252 taggedObjectEnc' opts contentsFieldName =
256− Tagged . (\z -> B.char7 ',' <> builder contentsFieldName <> B.char7 ':' <> z) .
253+ Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .
257− gbuilder opts
254+ gToEncoding opts
258
255
259--------------------------------------------------------------------------------
256--------------------------------------------------------------------------------
260
257
@@ -290,7 +287,7 @@ instance ( GToJSON a, ConsToJSON a
290--------------------------------------------------------------------------------
287--------------------------------------------------------------------------------
291
288
292class TwoElemArrayEnc f where
289class TwoElemArrayEnc f where
293− twoElemArrayEnc :: Options -> f a -> B.Builder
290+ twoElemArrayEnc :: Options -> f a -> Encoding
294
291
295instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) where
292instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) where
296 twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
293 twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
@@ -298,9 +295,9 @@ instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) whe
298
295
299instance ( GToEncoding a, ConsToEncoding a
296instance ( GToEncoding a, ConsToEncoding a
300 , Constructor c ) => TwoElemArrayEnc (C1 c a) where
297 , Constructor c ) => TwoElemArrayEnc (C1 c a) where
301− twoElemArrayEnc opts x = fromEncoding . tuple $
298+ twoElemArrayEnc opts x = E.tuple $
302− builder (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
299+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
303− gbuilder opts x
300+ gToEncoding opts x
304
301
305--------------------------------------------------------------------------------
302--------------------------------------------------------------------------------
306
303
@@ -329,15 +326,15 @@ instance GToJSON f => ConsToJSON' f False where
329--------------------------------------------------------------------------------
326--------------------------------------------------------------------------------
330
327
331class ConsToEncoding f where
328class ConsToEncoding f where
332− consToEncoding :: Options -> f a -> B.Builder
329+ consToEncoding :: Options -> f a -> Encoding
333
330
334class ConsToEncoding' f isRecord where
331class ConsToEncoding' f isRecord where
335 consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
332 consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
336− -> f a -> Tagged isRecord B.Builder
333+ -> f a -> Tagged isRecord Encoding
337
334
338instance ( IsRecord f isRecord
335instance ( IsRecord f isRecord
339 , ConsToEncoding' f isRecord ) => ConsToEncoding f where
336 , ConsToEncoding' f isRecord ) => ConsToEncoding f where
340− consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
337+ consToEncoding opts = (unTagged :: Tagged isRecord Encoding -> Encoding)
341 . consToEncoding' opts (isUnary (undefined :: f a))
338 . consToEncoding' opts (isUnary (undefined :: f a))
342
339
343instance (RecordToEncoding f) => ConsToEncoding' f True where
340instance (RecordToEncoding f) => ConsToEncoding' f True where
@@ -345,10 +342,10 @@ instance (RecordToEncoding f) => ConsToEncoding' f True where
345 let (enc, mbVal) = recordToEncoding opts x
342 let (enc, mbVal) = recordToEncoding opts x
346 in case (unwrapUnaryRecords opts, isUn, mbVal) of
343 in case (unwrapUnaryRecords opts, isUn, mbVal) of
347 (True, True, Just val) -> Tagged val
344 (True, True, Just val) -> Tagged val
348− _ -> Tagged $ B.char7 '{' <> enc <> B.char7 '}'
345+ _ -> Tagged $ E.wrapObject enc
349
346
350instance GToEncoding f => ConsToEncoding' f False where
347instance GToEncoding f => ConsToEncoding' f False where
351− consToEncoding' opts _ = Tagged . gbuilder opts
348+ consToEncoding' opts _ = Tagged . gToEncoding opts
352
349
353--------------------------------------------------------------------------------
350--------------------------------------------------------------------------------
354
351
@@ -379,16 +376,16 @@ class RecordToEncoding f where
379 -- 1st element: whole thing
376 -- 1st element: whole thing
380 -- 2nd element: in case the record has only 1 field, just the value
377 -- 2nd element: in case the record has only 1 field, just the value
381 -- of the field (without the key); 'Nothing' otherwise
378 -- of the field (without the key); 'Nothing' otherwise
382− recordToEncoding :: Options -> f a -> (B.Builder, Maybe B.Builder)
379+ recordToEncoding :: Options -> f a -> (Encoding, Maybe Encoding)
383
380
384instance (RecordToEncoding a, RecordToEncoding b) => RecordToEncoding (a :*: b) where
381instance (RecordToEncoding a, RecordToEncoding b) => RecordToEncoding (a :*: b) where
385 recordToEncoding opts (a :*: b) | omitNothingFields opts =
382 recordToEncoding opts (a :*: b) | omitNothingFields opts =
386− (mconcat $ intersperse (B.char7 ',') $
383+ (mconcat $ intersperse E.comma $
387− filter (not . BSL.null . B.toLazyByteString)
384+ filter (not . E.nullEncoding)
388 [fst (recordToEncoding opts a), fst (recordToEncoding opts b)]
385 [fst (recordToEncoding opts a), fst (recordToEncoding opts b)]
389 , Nothing)
386 , Nothing)
390 recordToEncoding opts (a :*: b) =
387 recordToEncoding opts (a :*: b) =
391− (fst (recordToEncoding opts a) <> B.char7 ',' <>
388+ (fst (recordToEncoding opts a) <> E.comma <>
392 fst (recordToEncoding opts b),
389 fst (recordToEncoding opts b),
393 Nothing)
390 Nothing)
394
391
@@ -401,11 +398,11 @@ instance OVERLAPPING_ (Selector s, ToJSON a) =>
401 , K1 Nothing <- k1 = (mempty, Nothing)
398 , K1 Nothing <- k1 = (mempty, Nothing)
402 recordToEncoding opts m1 = fieldToEncoding opts m1
399 recordToEncoding opts m1 = fieldToEncoding opts m1
403
400
404−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)
405fieldToEncoding opts m1 =
402fieldToEncoding opts m1 =
406− let keyBuilder = builder (fieldLabelModifier opts $ selName m1)
403+ let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
407− valueBuilder = gbuilder opts (unM1 m1)
404+ valueBuilder = gToEncoding opts (unM1 m1)
408− in (keyBuilder <> B.char7 ':' <> valueBuilder, Just valueBuilder)
405+ in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)
409
406
410--------------------------------------------------------------------------------
407--------------------------------------------------------------------------------
411
408
@@ -433,20 +430,20 @@ instance OVERLAPPABLE_ (GToJSON a) => WriteProduct a where
433--------------------------------------------------------------------------------
430--------------------------------------------------------------------------------
434
431
435class EncodeProduct f where
432class EncodeProduct f where
436− encodeProduct :: Options -> f a -> B.Builder
433+ encodeProduct :: Options -> f a -> Encoding
437
434
438instance ( EncodeProduct a
435instance ( EncodeProduct a
439 , EncodeProduct b ) => EncodeProduct (a :*: b) where
436 , EncodeProduct b ) => EncodeProduct (a :*: b) where
440 encodeProduct opts (a :*: b) | omitNothingFields opts =
437 encodeProduct opts (a :*: b) | omitNothingFields opts =
441− mconcat $ intersperse (B.char7 ',') $
438+ mconcat $ intersperse E.comma $
442− filter (not . BSL.null . B.toLazyByteString)
439+ filter (not . E.nullEncoding)
443 [encodeProduct opts a, encodeProduct opts b]
440 [encodeProduct opts a, encodeProduct opts b]
444 encodeProduct opts (a :*: b) = encodeProduct opts a <>
441 encodeProduct opts (a :*: b) = encodeProduct opts a <>
445− B.char7 ',' <>
442+ E.comma <>
446 encodeProduct opts b
443 encodeProduct opts b
447
444
448instance OVERLAPPABLE_ (GToEncoding a) => EncodeProduct a where
445instance OVERLAPPABLE_ (GToEncoding a) => EncodeProduct a where
449− encodeProduct opts = gbuilder opts
446+ encodeProduct opts = gToEncoding opts
450
447
451--------------------------------------------------------------------------------
448--------------------------------------------------------------------------------
452
449
@@ -468,7 +465,7 @@ instance ( GToJSON a, ConsToJSON a
468--------------------------------------------------------------------------------
465--------------------------------------------------------------------------------
469
466
470class ObjectWithSingleFieldEnc f where
467class ObjectWithSingleFieldEnc f where
471− objectWithSingleFieldEnc :: Options -> f a -> B.Builder
468+ objectWithSingleFieldEnc :: Options -> f a -> Encoding
472
469
473instance ( ObjectWithSingleFieldEnc a
470instance ( ObjectWithSingleFieldEnc a
474 , ObjectWithSingleFieldEnc b ) => ObjectWithSingleFieldEnc (a :+: b) where
471 , ObjectWithSingleFieldEnc b ) => ObjectWithSingleFieldEnc (a :+: b) where
@@ -478,15 +475,13 @@ instance ( ObjectWithSingleFieldEnc a
478instance ( GToEncoding a, ConsToEncoding a
475instance ( GToEncoding a, ConsToEncoding a
479 , Constructor c ) => ObjectWithSingleFieldEnc (C1 c a) where
476 , Constructor c ) => ObjectWithSingleFieldEnc (C1 c a) where
480 objectWithSingleFieldEnc opts v =
477 objectWithSingleFieldEnc opts v =
481− B.char7 '{' <>
478+ E.openCurly <>
479+ toEncoding
482− builder (constructorTagModifier opts
480+ (constructorTagModifier opts
483− (conName (undefined :: t c a p))) <>
481+ (conName (undefined :: t c a p))) <>
484− B.char7 ':' <>
482+ E.colon <>
485− gbuilder opts v <>
486− B.char7 '}'
487−
488−gbuilder :: GToEncoding f => Options -> f a -> Builder
489−gbuilder opts = fromEncoding . gToEncoding opts
483+ gToEncoding opts v <>
484+ E.closeCurly
490
485
491--------------------------------------------------------------------------------
486--------------------------------------------------------------------------------
492-- Generic parseJSON
487-- Generic parseJSON
Data/Aeson/Types/Instances.hs+40−41
@@ -78,8 +78,6 @@ module Data.Aeson.Types.Instances
78 , (.:?)
78 , (.:?)
79 , (.:!)
79 , (.:!)
80 , (.!=)
80 , (.!=)
81− , tuple
82− , (>*<)
83 , typeMismatch
81 , typeMismatch
84
82
85 , listEncoding
83 , listEncoding
@@ -87,10 +85,12 @@ module Data.Aeson.Types.Instances
87 , listParser
85 , listParser
88 ) where
86 ) where
89
87
90−import Data.Aeson.Types.Instances.Tuple (tuple, (>*<))
88+import Data.Aeson.Types.Instances.Tuple ()
89+
90+import Data.Aeson.Encoding.Internal (Encoding (..), emptyArray_, dict, tuple, (>*<))
91
91
92import Control.Applicative (Const(..))
92import Control.Applicative (Const(..))
93−import Data.Aeson.Encode.Functions (builder, builder', encode, list, encodeWithKey, encodeMap)
93+import Data.Aeson.Encode.Functions (builder)
94import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
94import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
95import Data.Aeson.Types.Class
95import Data.Aeson.Types.Class
96import Data.Aeson.Types.Internal
96import Data.Aeson.Types.Internal
@@ -120,7 +120,7 @@ import Text.ParserCombinators.ReadP (readP_to_S)
120import Foreign.Storable (Storable)
120import Foreign.Storable (Storable)
121import Numeric.Natural (Natural)
121import Numeric.Natural (Natural)
122import Prelude hiding (foldr)
122import Prelude hiding (foldr)
123−import qualified Data.Aeson.Encode.Builder as E
123+import qualified Data.Aeson.Encode.Builder as EB
124import qualified Data.Aeson.Parser.Time as Time
124import qualified Data.Aeson.Parser.Time as Time
125import qualified Data.ByteString.Builder as B
125import qualified Data.ByteString.Builder as B
126import qualified Data.ByteString.Lazy as L
126import qualified Data.ByteString.Lazy as L
@@ -201,7 +201,7 @@ realFloatToJSON d
201
201
202realFloatToEncoding :: RealFloat a => a -> Encoding
202realFloatToEncoding :: RealFloat a => a -> Encoding
203realFloatToEncoding d
203realFloatToEncoding d
204− | isNaN d || isInfinite d = Encoding E.null_
204+ | isNaN d || isInfinite d = Encoding EB.null_
205 | otherwise = toEncoding (Scientific.fromFloatDigits d)
205 | otherwise = toEncoding (Scientific.fromFloatDigits d)
206{-# INLINE realFloatToEncoding #-}
206{-# INLINE realFloatToEncoding #-}
207
207
@@ -291,7 +291,7 @@ instance ToJSON1 Maybe where
291 {-# INLINE liftToJSON #-}
291 {-# INLINE liftToJSON #-}
292
292
293 liftToEncoding to _ (Just a) = to a
293 liftToEncoding to _ (Just a) = to a
294− liftToEncoding _ _ Nothing = Encoding E.null_
294+ liftToEncoding _ _ Nothing = Encoding EB.null_
295 {-# INLINE liftToEncoding #-}
295 {-# INLINE liftToEncoding #-}
296
296
297instance (ToJSON a) => ToJSON (Maybe a) where
297instance (ToJSON a) => ToJSON (Maybe a) where
@@ -369,7 +369,7 @@ instance ToJSON Bool where
369 toJSON = Bool
369 toJSON = Bool
370 {-# INLINE toJSON #-}
370 {-# INLINE toJSON #-}
371
371
372− toEncoding = Encoding . E.bool
372+ toEncoding = Encoding . EB.bool
373 {-# INLINE toEncoding #-}
373 {-# INLINE toEncoding #-}
374
374
375instance FromJSON Bool where
375instance FromJSON Bool where
@@ -398,7 +398,7 @@ instance ToJSON () where
398 toJSON _ = emptyArray
398 toJSON _ = emptyArray
399 {-# INLINE toJSON #-}
399 {-# INLINE toJSON #-}
400
400
401− toEncoding _ = E.emptyArray_
401+ toEncoding _ = emptyArray_
402 {-# INLINE toEncoding #-}
402 {-# INLINE toEncoding #-}
403
403
404instance FromJSON () where
404instance FromJSON () where
@@ -415,10 +415,10 @@ instance ToJSON Char where
415 toJSONList = String . T.pack
415 toJSONList = String . T.pack
416 {-# INLINE toJSONList #-}
416 {-# INLINE toJSONList #-}
417
417
418− toEncoding = Encoding . E.string . (:[])
418+ toEncoding = Encoding . EB.string . (:[])
419 {-# INLINE toEncoding #-}
419 {-# INLINE toEncoding #-}
420
420
421− toEncodingList = Encoding . E.string
421+ toEncodingList = Encoding . EB.string
422 {-# INLINE toEncodingList #-}
422 {-# INLINE toEncodingList #-}
423
423
424instance FromJSON Char where
424instance FromJSON Char where
@@ -490,7 +490,7 @@ instance HasResolution a => ToJSON (Fixed a) where
490 toJSON = Number . realToFrac
490 toJSON = Number . realToFrac
491 {-# INLINE toJSON #-}
491 {-# INLINE toJSON #-}
492
492
493− toEncoding = Encoding . E.number . realToFrac
493+ toEncoding = Encoding . EB.number . realToFrac
494 {-# INLINE toEncoding #-}
494 {-# INLINE toEncoding #-}
495
495
496-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
496-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
@@ -643,7 +643,7 @@ instance ToJSON Text where
643 toJSON = String
643 toJSON = String
644 {-# INLINE toJSON #-}
644 {-# INLINE toJSON #-}
645
645
646− toEncoding = Encoding . E.text
646+ toEncoding = Encoding . EB.text
647 {-# INLINE toEncoding #-}
647 {-# INLINE toEncoding #-}
648
648
649instance FromJSON Text where
649instance FromJSON Text where
@@ -656,7 +656,7 @@ instance ToJSON LT.Text where
656
656
657 toEncoding t = Encoding $
657 toEncoding t = Encoding $
658 B.char7 '"' <>
658 B.char7 '"' <>
659− LT.foldrChunks (\x xs -> E.unquoted x <> xs) (B.char7 '"') t
659+ LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t
660 {-# INLINE toEncoding #-}
660 {-# INLINE toEncoding #-}
661
661
662instance FromJSON LT.Text where
662instance FromJSON LT.Text where
@@ -716,7 +716,7 @@ instance ToJSON Scientific where
716 toJSON = Number
716 toJSON = Number
717 {-# INLINE toJSON #-}
717 {-# INLINE toJSON #-}
718
718
719− toEncoding = Encoding . E.number
719+ toEncoding = Encoding . EB.number
720 {-# INLINE toEncoding #-}
720 {-# INLINE toEncoding #-}
721
721
722instance FromJSON Scientific where
722instance FromJSON Scientific where
@@ -823,11 +823,11 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
823
823
824 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
824 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
825 liftToEncoding g _ = case toJSONKey of
825 liftToEncoding g _ = case toJSONKey of
826− ToJSONKeyText (_,f) -> encodeMap f g M.minViewWithKey M.foldrWithKey
826+ ToJSONKeyText (_,f) -> dict f g M.foldrWithKey
827− ToJSONKeyValue (_,f) -> list (pairEncoding f) . M.toList
827+ ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList
828 where
828 where
829 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
829 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
830− pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder' g b
830+ pairEncoding f (a, b) = tuple $ f a >*< g b
831 {-# INLINE liftToEncoding #-}
831 {-# INLINE liftToEncoding #-}
832
832
833instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
833instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where
@@ -902,7 +902,7 @@ instance ToJSON1 Vector where
902 {-# INLINE liftToJSON #-}
902 {-# INLINE liftToJSON #-}
903
903
904 liftToEncoding to _ xs
904 liftToEncoding to _ xs
905− | V.null xs = E.emptyArray_
905+ | V.null xs = emptyArray_
906 | otherwise = Encoding $
906 | otherwise = Encoding $
907 B.char7 '[' <> fromEncoding (to (V.unsafeHead xs)) <>
907 B.char7 '[' <> fromEncoding (to (V.unsafeHead xs)) <>
908 V.foldr go (B.char7 ']') (V.unsafeTail xs)
908 V.foldr go (B.char7 ']') (V.unsafeTail xs)
@@ -919,7 +919,7 @@ instance (ToJSON a) => ToJSON (Vector a) where
919
919
920encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
920encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
921encodeVector xs
921encodeVector xs
922− | VG.null xs = E.emptyArray_
922+ | VG.null xs = emptyArray_
923 | otherwise = Encoding $
923 | otherwise = Encoding $
924 B.char7 '[' <> builder (VG.unsafeHead xs) <>
924 B.char7 '[' <> builder (VG.unsafeHead xs) <>
925 VG.foldr go (B.char7 ']') (VG.unsafeTail xs)
925 VG.foldr go (B.char7 ']') (VG.unsafeTail xs)
@@ -1006,11 +1006,11 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1006
1006
1007 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1007 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1008 liftToEncoding g _ = case toJSONKey of
1008 liftToEncoding g _ = case toJSONKey of
1009− ToJSONKeyText (_,f) -> encodeWithKey f g H.foldrWithKey
1009+ ToJSONKeyText (_,f) -> dict f g H.foldrWithKey
1010− ToJSONKeyValue (_,f) -> list (pairEncoding f) . H.toList
1010+ ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList
1011 where
1011 where
1012 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1012 -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1013− pairEncoding f (a, b) = tuple $ fromEncoding (f a) >*< builder' g b
1013+ pairEncoding f (a, b) = tuple $ f a >*< g b
1014 {-# INLINE liftToEncoding #-}
1014 {-# INLINE liftToEncoding #-}
1015
1015
1016instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1016instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
@@ -1047,7 +1047,7 @@ instance ToJSON Value where
1047 toJSON a = a
1047 toJSON a = a
1048 {-# INLINE toJSON #-}
1048 {-# INLINE toJSON #-}
1049
1049
1050− toEncoding = Encoding . E.encodeToBuilder
1050+ toEncoding = Encoding . EB.encodeToBuilder
1051 {-# INLINE toEncoding #-}
1051 {-# INLINE toEncoding #-}
1052
1052
1053instance FromJSON Value where
1053instance FromJSON Value where
@@ -1078,21 +1078,21 @@ instance FromJSON DotNetTime where
1078
1078
1079instance ToJSON Day where
1079instance ToJSON Day where
1080 toJSON = stringEncoding
1080 toJSON = stringEncoding
1081− toEncoding z = Encoding (E.quote $ E.day z)
1081+ toEncoding z = Encoding (EB.quote $ EB.day z)
1082
1082
1083instance FromJSON Day where
1083instance FromJSON Day where
1084 parseJSON = withText "Day" (Time.run Time.day)
1084 parseJSON = withText "Day" (Time.run Time.day)
1085
1085
1086instance ToJSON TimeOfDay where
1086instance ToJSON TimeOfDay where
1087 toJSON = stringEncoding
1087 toJSON = stringEncoding
1088− toEncoding z = Encoding (E.quote $ E.timeOfDay z)
1088+ toEncoding z = Encoding (EB.quote $ EB.timeOfDay z)
1089
1089
1090instance FromJSON TimeOfDay where
1090instance FromJSON TimeOfDay where
1091 parseJSON = withText "TimeOfDay" (Time.run Time.timeOfDay)
1091 parseJSON = withText "TimeOfDay" (Time.run Time.timeOfDay)
1092
1092
1093instance ToJSON LocalTime where
1093instance ToJSON LocalTime where
1094 toJSON = stringEncoding
1094 toJSON = stringEncoding
1095− toEncoding z = Encoding (E.quote $ E.localTime z)
1095+ toEncoding z = Encoding (EB.quote $ EB.localTime z)
1096
1096
1097instance FromJSON LocalTime where
1097instance FromJSON LocalTime where
1098 parseJSON = withText "LocalTime" (Time.run Time.localTime)
1098 parseJSON = withText "LocalTime" (Time.run Time.localTime)
@@ -1100,7 +1100,7 @@ instance FromJSON LocalTime where
1100instance ToJSON ZonedTime where
1100instance ToJSON ZonedTime where
1101 toJSON = stringEncoding
1101 toJSON = stringEncoding
1102
1102
1103− toEncoding z = Encoding (E.quote $ E.zonedTime z)
1103+ toEncoding z = Encoding (EB.quote $ EB.zonedTime z)
1104
1104
1105formatMillis :: (FormatTime t) => t -> String
1105formatMillis :: (FormatTime t) => t -> String
1106formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1106formatMillis = take 3 . formatTime defaultTimeLocale "%q"
@@ -1111,11 +1111,19 @@ instance FromJSON ZonedTime where
1111instance ToJSON UTCTime where
1111instance ToJSON UTCTime where
1112 toJSON = stringEncoding
1112 toJSON = stringEncoding
1113
1113
1114− toEncoding t = Encoding (E.quote $ E.utcTime t)
1114+ toEncoding t = Encoding (EB.quote $ EB.utcTime t)
1115
1115
1116-- | Encode something to a JSON string.
1116-- | Encode something to a JSON string.
1117+--
1118+-- TODO: remove me, this is a hack
1117stringEncoding :: (ToJSON a) => a -> Value
1119stringEncoding :: (ToJSON a) => a -> Value
1118−stringEncoding = String . T.dropAround (== '"') . T.decodeLatin1 . L.toStrict . encode
1120+stringEncoding = String
1121+ . T.dropAround (== '"')
1122+ . T.decodeLatin1
1123+ . L.toStrict
1124+ . B.toLazyByteString
1125+ . fromEncoding
1126+ . toEncoding
1119{-# INLINE stringEncoding #-}
1127{-# INLINE stringEncoding #-}
1120
1128
1121instance FromJSON UTCTime where
1129instance FromJSON UTCTime where
@@ -1125,7 +1133,7 @@ instance ToJSON NominalDiffTime where
1125 toJSON = Number . realToFrac
1133 toJSON = Number . realToFrac
1126 {-# INLINE toJSON #-}
1134 {-# INLINE toJSON #-}
1127
1135
1128− toEncoding = Encoding . E.number . realToFrac
1136+ toEncoding = Encoding . EB.number . realToFrac
1129 {-# INLINE toEncoding #-}
1137 {-# INLINE toEncoding #-}
1130
1138
1131-- | /WARNING:/ Only parse lengths of time from trusted input
1139-- | /WARNING:/ Only parse lengths of time from trusted input
@@ -1216,7 +1224,7 @@ instance ToJSON (Proxy a) where
1216 toJSON _ = Null
1224 toJSON _ = Null
1217 {-# INLINE toJSON #-}
1225 {-# INLINE toJSON #-}
1218
1226
1219− toEncoding _ = Encoding E.null_
1227+ toEncoding _ = Encoding EB.null_
1220 {-# INLINE toEncoding #-}
1228 {-# INLINE toEncoding #-}
1221
1229
1222instance FromJSON (Proxy a) where
1230instance FromJSON (Proxy a) where
@@ -1367,15 +1375,6 @@ withBool _ f (Bool arr) = f arr
1367withBool expected _ v = typeMismatch expected v
1375withBool expected _ v = typeMismatch expected v
1368{-# INLINE withBool #-}
1376{-# INLINE withBool #-}
1369
1377
1370−instance KeyValue Pair where
1371− name .= value = (name, toJSON value)
1372− {-# INLINE (.=) #-}
1373−
1374−instance KeyValue Series where
1375− name .= value = Value . Encoding $
1376− E.text name <> B.char7 ':' <> builder value
1377− {-# INLINE (.=) #-}
1378−
1379-- | Convert a value from JSON, failing if the types do not match.
1378-- | Convert a value from JSON, failing if the types do not match.
1380fromJSON :: (FromJSON a) => Value -> Result a
1379fromJSON :: (FromJSON a) => Value -> Result a
1381fromJSON = parse parseJSON
1380fromJSON = parse parseJSON
Data/Aeson/Types/Instances/Tuple.hs+121−134
@@ -10,16 +10,14 @@
10-- Portability: portable
10-- Portability: portable
11--
11--
12-- Tuple instances
12-- Tuple instances
13−module Data.Aeson.Types.Instances.Tuple (tuple, (>*<)) where
13+module Data.Aeson.Types.Instances.Tuple () where
14
14
15−import Data.Aeson.Encode.Functions (builder)
15+import Data.Aeson.Encoding.Internal (tuple, (>*<))
16import Data.Aeson.Types.Class
16import Data.Aeson.Types.Class
17import Data.Aeson.Types.Internal
17import Data.Aeson.Types.Internal
18−import Data.Monoid ((<>))
19
18
20import qualified Data.Vector as V
19import qualified Data.Vector as V
21import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
20import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite)
22−import qualified Data.ByteString.Builder as B
23
21
24#if MIN_VERSION_base(4,8,0)
22#if MIN_VERSION_base(4,8,0)
25#else
23#else
@@ -29,15 +27,6 @@ import Control.Applicative ((<$>), (<*>))
29parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
27parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
30parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
28parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
31
29
32−(>*<) :: B.Builder -> B.Builder -> B.Builder
33−a >*< b = a <> B.char7 ',' <> b
34−{-# INLINE (>*<) #-}
35−infixr 6 >*<
36−
37−tuple :: B.Builder -> Encoding
38−tuple b = Encoding (B.char7 '[' <> b <> B.char7 ']')
39−{-# INLINE tuple #-}
40−
41-- Local copy of withArray
30-- Local copy of withArray
42withArray :: String -> (Array -> Parser a) -> Value -> Parser a
31withArray :: String -> (Array -> Parser a) -> Value -> Parser a
43withArray _ f (Array arr) = f arr
32withArray _ f (Array arr) = f arr
@@ -57,8 +46,8 @@ instance ToJSON2 ((,) ) where
57 {-# INLINE liftToJSON2 #-}
46 {-# INLINE liftToJSON2 #-}
58
47
59 liftToEncoding2 toA _ toB _ (a, b) = tuple $
48 liftToEncoding2 toA _ toB _ (a, b) = tuple $
60− fromEncoding (toA a) >*<
49+ toA a >*<
61− fromEncoding (toB b)
50+ toB b
62 {-# INLINE liftToEncoding2 #-}
51 {-# INLINE liftToEncoding2 #-}
63
52
64instance (ToJSON a) => ToJSON1 ((,) a) where
53instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -102,9 +91,9 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
102 {-# INLINE liftToJSON2 #-}
91 {-# INLINE liftToJSON2 #-}
103
92
104 liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
93 liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
105− builder a >*<
94+ toEncoding a >*<
106− fromEncoding (toB b) >*<
95+ toB b >*<
107− fromEncoding (toC c)
96+ toC c
108 {-# INLINE liftToEncoding2 #-}
97 {-# INLINE liftToEncoding2 #-}
109
98
110instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
99instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -150,10 +139,10 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
150 {-# INLINE liftToJSON2 #-}
139 {-# INLINE liftToJSON2 #-}
151
140
152 liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
141 liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
153− builder a >*<
142+ toEncoding a >*<
154− builder b >*<
143+ toEncoding b >*<
155− fromEncoding (toC c) >*<
144+ toC c >*<
156− fromEncoding (toD d)
145+ toD d
157 {-# INLINE liftToEncoding2 #-}
146 {-# INLINE liftToEncoding2 #-}
158
147
159instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
148instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -201,11 +190,11 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
201 {-# INLINE liftToJSON2 #-}
190 {-# INLINE liftToJSON2 #-}
202
191
203 liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
192 liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
204− builder a >*<
193+ toEncoding a >*<
205− builder b >*<
194+ toEncoding b >*<
206− builder c >*<
195+ toEncoding c >*<
207− fromEncoding (toD d) >*<
196+ toD d >*<
208− fromEncoding (toE e)
197+ toE e
209 {-# INLINE liftToEncoding2 #-}
198 {-# INLINE liftToEncoding2 #-}
210
199
211instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
200instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -255,12 +244,12 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
255 {-# INLINE liftToJSON2 #-}
244 {-# INLINE liftToJSON2 #-}
256
245
257 liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
246 liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
258− builder a >*<
247+ toEncoding a >*<
259− builder b >*<
248+ toEncoding b >*<
260− builder c >*<
249+ toEncoding c >*<
261− builder d >*<
250+ toEncoding d >*<
262− fromEncoding (toE e) >*<
251+ toE e >*<
263− fromEncoding (toF f)
252+ toF f
264 {-# INLINE liftToEncoding2 #-}
253 {-# INLINE liftToEncoding2 #-}
265
254
266instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
255instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -312,13 +301,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
312 {-# INLINE liftToJSON2 #-}
301 {-# INLINE liftToJSON2 #-}
313
302
314 liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
303 liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
315− builder a >*<
304+ toEncoding a >*<
316− builder b >*<
305+ toEncoding b >*<
317− builder c >*<
306+ toEncoding c >*<
318− builder d >*<
307+ toEncoding d >*<
319− builder e >*<
308+ toEncoding e >*<
320− fromEncoding (toF f) >*<
309+ toF f >*<
321− fromEncoding (toG g)
310+ toG g
322 {-# INLINE liftToEncoding2 #-}
311 {-# INLINE liftToEncoding2 #-}
323
312
324instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
313instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -372,14 +361,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
372 {-# INLINE liftToJSON2 #-}
361 {-# INLINE liftToJSON2 #-}
373
362
374 liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
363 liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
375− builder a >*<
364+ toEncoding a >*<
376− builder b >*<
365+ toEncoding b >*<
377− builder c >*<
366+ toEncoding c >*<
378− builder d >*<
367+ toEncoding d >*<
379− builder e >*<
368+ toEncoding e >*<
380− builder f >*<
369+ toEncoding f >*<
381− fromEncoding (toG g) >*<
370+ toG g >*<
382− fromEncoding (toH h)
371+ toH h
383 {-# INLINE liftToEncoding2 #-}
372 {-# INLINE liftToEncoding2 #-}
384
373
385instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
374instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -435,15 +424,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
435 {-# INLINE liftToJSON2 #-}
424 {-# INLINE liftToJSON2 #-}
436
425
437 liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
426 liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
438− builder a >*<
427+ toEncoding a >*<
439− builder b >*<
428+ toEncoding b >*<
440− builder c >*<
429+ toEncoding c >*<
441− builder d >*<
430+ toEncoding d >*<
442− builder e >*<
431+ toEncoding e >*<
443− builder f >*<
432+ toEncoding f >*<
444− builder g >*<
433+ toEncoding g >*<
445− fromEncoding (toH h) >*<
434+ toH h >*<
446− fromEncoding (toI i)
435+ toI i
447 {-# INLINE liftToEncoding2 #-}
436 {-# INLINE liftToEncoding2 #-}
448
437
449instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
438instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
@@ -501,16 +490,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
501 {-# INLINE liftToJSON2 #-}
490 {-# INLINE liftToJSON2 #-}
502
491
503 liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
492 liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
504− builder a >*<
493+ toEncoding a >*<
505− builder b >*<
494+ toEncoding b >*<
506− builder c >*<
495+ toEncoding c >*<
507− builder d >*<
496+ toEncoding d >*<
508− builder e >*<
497+ toEncoding e >*<
509− builder f >*<
498+ toEncoding f >*<
510− builder g >*<
499+ toEncoding g >*<
511− builder h >*<
500+ toEncoding h >*<
512− fromEncoding (toI i) >*<
501+ toI i >*<
513− fromEncoding (toJ j)
502+ toJ j
514 {-# INLINE liftToEncoding2 #-}
503 {-# INLINE liftToEncoding2 #-}
515
504
516instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
505instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
@@ -570,17 +559,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
570 {-# INLINE liftToJSON2 #-}
559 {-# INLINE liftToJSON2 #-}
571
560
572 liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
561 liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
573− builder a >*<
562+ toEncoding a >*<
574− builder b >*<
563+ toEncoding b >*<
575− builder c >*<
564+ toEncoding c >*<
576− builder d >*<
565+ toEncoding d >*<
577− builder e >*<
566+ toEncoding e >*<
578− builder f >*<
567+ toEncoding f >*<
579− builder g >*<
568+ toEncoding g >*<
580− builder h >*<
569+ toEncoding h >*<
581− builder i >*<
570+ toEncoding i >*<
582− fromEncoding (toJ j) >*<
571+ toJ j >*<
583− fromEncoding (toK k)
572+ toK k
584 {-# INLINE liftToEncoding2 #-}
573 {-# INLINE liftToEncoding2 #-}
585
574
586instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
575instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
@@ -642,18 +631,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
642 {-# INLINE liftToJSON2 #-}
631 {-# INLINE liftToJSON2 #-}
643
632
644 liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
633 liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
645− builder a >*<
634+ toEncoding a >*<
646− builder b >*<
635+ toEncoding b >*<
647− builder c >*<
636+ toEncoding c >*<
648− builder d >*<
637+ toEncoding d >*<
649− builder e >*<
638+ toEncoding e >*<
650− builder f >*<
639+ toEncoding f >*<
651− builder g >*<
640+ toEncoding g >*<
652− builder h >*<
641+ toEncoding h >*<
653− builder i >*<
642+ toEncoding i >*<
654− builder j >*<
643+ toEncoding j >*<
655− fromEncoding (toK k) >*<
644+ toK k >*<
656− fromEncoding (toL l)
645+ toL l
657 {-# INLINE liftToEncoding2 #-}
646 {-# INLINE liftToEncoding2 #-}
658
647
659instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
648instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
@@ -717,19 +706,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
717 {-# INLINE liftToJSON2 #-}
706 {-# INLINE liftToJSON2 #-}
718
707
719 liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
708 liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
720− builder a >*<
709+ toEncoding a >*<
721− builder b >*<
710+ toEncoding b >*<
722− builder c >*<
711+ toEncoding c >*<
723− builder d >*<
712+ toEncoding d >*<
724− builder e >*<
713+ toEncoding e >*<
725− builder f >*<
714+ toEncoding f >*<
726− builder g >*<
715+ toEncoding g >*<
727− builder h >*<
716+ toEncoding h >*<
728− builder i >*<
717+ toEncoding i >*<
729− builder j >*<
718+ toEncoding j >*<
730− builder k >*<
719+ toEncoding k >*<
731− fromEncoding (toL l) >*<
720+ toL l >*<
732− fromEncoding (toM m)
721+ toM m
733 {-# INLINE liftToEncoding2 #-}
722 {-# INLINE liftToEncoding2 #-}
734
723
735instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
724instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
@@ -795,20 +784,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
795 {-# INLINE liftToJSON2 #-}
784 {-# INLINE liftToJSON2 #-}
796
785
797 liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
786 liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
798− builder a >*<
787+ toEncoding a >*<
799− builder b >*<
788+ toEncoding b >*<
800− builder c >*<
789+ toEncoding c >*<
801− builder d >*<
790+ toEncoding d >*<
802− builder e >*<
791+ toEncoding e >*<
803− builder f >*<
792+ toEncoding f >*<
804− builder g >*<
793+ toEncoding g >*<
805− builder h >*<
794+ toEncoding h >*<
806− builder i >*<
795+ toEncoding i >*<
807− builder j >*<
796+ toEncoding j >*<
808− builder k >*<
797+ toEncoding k >*<
809− builder l >*<
798+ toEncoding l >*<
810− fromEncoding (toM m) >*<
799+ toM m >*<
811− fromEncoding (toN n)
800+ toN n
812 {-# INLINE liftToEncoding2 #-}
801 {-# INLINE liftToEncoding2 #-}
813
802
814instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
803instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
@@ -876,21 +865,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
876 {-# INLINE liftToJSON2 #-}
865 {-# INLINE liftToJSON2 #-}
877
866
878 liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
867 liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
879− builder a >*<
868+ toEncoding a >*<
880− builder b >*<
869+ toEncoding b >*<
881− builder c >*<
870+ toEncoding c >*<
882− builder d >*<
871+ toEncoding d >*<
883− builder e >*<
872+ toEncoding e >*<
884− builder f >*<
873+ toEncoding f >*<
885− builder g >*<
874+ toEncoding g >*<
886− builder h >*<
875+ toEncoding h >*<
887− builder i >*<
876+ toEncoding i >*<
888− builder j >*<
877+ toEncoding j >*<
889− builder k >*<
878+ toEncoding k >*<
890− builder l >*<
879+ toEncoding l >*<
891− builder m >*<
880+ toEncoding m >*<
892− fromEncoding (toN n) >*<
881+ toN n >*<
893− fromEncoding (toO o)
882+ toO o
894 {-# INLINE liftToEncoding2 #-}
883 {-# INLINE liftToEncoding2 #-}
895
884
896instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
885instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
@@ -935,5 +924,3 @@ instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f
935instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
924instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
936 parseJSON = parseJSON2
925 parseJSON = parseJSON2
937 {-# INLINE parseJSON #-}
926 {-# INLINE parseJSON #-}
938−
939−
Data/Aeson/Types/Internal.hs−50
@@ -24,9 +24,6 @@ module Data.Aeson.Types.Internal
24 (
24 (
25 -- * Core JSON types
25 -- * Core JSON types
26 Value(..)
26 Value(..)
27− , Encoding(..)
28− , unsafeToEncoding
29− , Series(..)
30 , Array
27 , Array
31 , emptyArray, isEmptyArray
28 , emptyArray, isEmptyArray
32 , Pair
29 , Pair
@@ -67,7 +64,6 @@ import Control.Applicative
67import Control.DeepSeq (NFData(..))
64import Control.DeepSeq (NFData(..))
68import Control.Monad (MonadPlus(..), ap)
65import Control.Monad (MonadPlus(..), ap)
69import qualified Control.Monad.Fail as Fail
66import qualified Control.Monad.Fail as Fail
70−import Data.ByteString.Builder (Builder, char7, toLazyByteString)
71import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
67import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
72import Data.Data (Data)
68import Data.Data (Data)
73import Data.Foldable (foldl')
69import Data.Foldable (foldl')
@@ -338,52 +334,6 @@ data Value = Object !Object
338 | Null
334 | Null
339 deriving (Eq, Read, Show, Typeable, Data)
335 deriving (Eq, Read, Show, Typeable, Data)
340
336
341−-- | An encoding of a JSON value.
342−newtype Encoding = Encoding {
343− fromEncoding :: Builder
344− -- ^ Acquire the underlying bytestring builder.
345− } deriving (Semigroup,Monoid)
346−
347−-- | Make Encoding from Builder.
348−--
349−-- Use with care! You have to make sure that the passed Builder
350−-- is a valid JSON Encoding!
351−unsafeToEncoding :: Builder -> Encoding
352−unsafeToEncoding = Encoding
353−
354−instance Show Encoding where
355− show (Encoding e) = show (toLazyByteString e)
356−
357−instance Eq Encoding where
358− Encoding a == Encoding b = toLazyByteString a == toLazyByteString b
359−
360−instance Ord Encoding where
361− compare (Encoding a) (Encoding b) =
362− compare (toLazyByteString a) (toLazyByteString b)
363−
364−-- | A series of values that, when encoded, should be separated by
365−-- commas. Since 0.11.0.0, the '.=' operator is overloaded to create
366−-- either @(Text, Value)@ or 'Series'. You can use Series when
367−-- encoding directly to a bytestring builder as in the following
368−-- example:
369−--
370−-- > toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)
371−data Series = Empty
372− | Value Encoding
373− deriving (Typeable)
374−
375−instance Semigroup Series where
376− Empty <> a = a
377− Value a <> b =
378− Value $
379− a <> case b of
380− Empty -> mempty
381− Value c -> Encoding (char7 ',') <> c
382−
383−instance Monoid Series where
384− mempty = Empty
385− mappend = (<>)
386−
387-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
337-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
388-- serialization format as Microsoft .NET, whose
338-- serialization format as Microsoft .NET, whose
389-- <https://msdn.microsoft.com/en-us/library/system.datetime(v=vs.110).aspx System.DateTime>
339-- <https://msdn.microsoft.com/en-us/library/system.datetime(v=vs.110).aspx System.DateTime>
aeson.cabal+2
@@ -70,6 +70,8 @@ library
70 exposed-modules:
70 exposed-modules:
71 Data.Aeson
71 Data.Aeson
72 Data.Aeson.Encode
72 Data.Aeson.Encode
73+ Data.Aeson.Encoding
74+ Data.Aeson.Encoding.Internal
73 Data.Aeson.Internal
75 Data.Aeson.Internal
74 Data.Aeson.Internal.Time
76 Data.Aeson.Internal.Time
75 Data.Aeson.Parser
77 Data.Aeson.Parser
benchmarks/aeson-benchmarks.cabal+2
@@ -15,6 +15,8 @@ library
15
15
16 exposed-modules:
16 exposed-modules:
17 Data.Aeson
17 Data.Aeson
18+ Data.Aeson.Encoding
19+ Data.Aeson.Encoding.Internal
18 Data.Aeson.Encode
20 Data.Aeson.Encode
19 Data.Aeson.Encode.Builder
21 Data.Aeson.Encode.Builder
20 Data.Aeson.Encode.Functions
22 Data.Aeson.Encode.Functions
tuple-instances.hs+4−4
@@ -1,5 +1,5 @@
1#!/usr/bin/env stack
1#!/usr/bin/env stack
2−{- stack --resolver=lts-5.9 runghc
2+{- stack --resolver=lts-6.0 runghc
3 --package mtl
3 --package mtl
4 --package dlist
4 --package dlist
5-}
5-}
@@ -45,9 +45,9 @@ tuple n = fold $ flip execState DList.empty $ do
45 t [" liftToEncoding2 ", toPrev, " _ ", toLast, " _ ", vs', " = tuple $" ]
45 t [" liftToEncoding2 ", toPrev, " _ ", toLast, " _ ", vs', " = tuple $" ]
46 forM_ (zip [0..] vs) $ \(i, v) -> t . (" " :) $ case i of
46 forM_ (zip [0..] vs) $ \(i, v) -> t . (" " :) $ case i of
47
47
48− _ | i == n - 1 -> [ "fromEncoding (", toLast, " ", v, ")" ]
48+ _ | i == n - 1 -> [ toLast, " ", v ]
49− _ | i == n - 2 -> [ "fromEncoding (", toPrev, " ", v, ") >*<" ]
49+ _ | i == n - 2 -> [ toPrev, " ", v, " >*<" ]
50− _ | otherwise -> [ "builder ", v, " >*<" ]
50+ _ | otherwise -> [ "toEncoding ", v, " >*<" ]
51 t [" {-# INLINE liftToEncoding2 #-}" ]
51 t [" {-# INLINE liftToEncoding2 #-}" ]
52 t []
52 t []
53
53