@@ -1,30 +1,27 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE CPP #-}
2−{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE EmptyDataDecls #-}
4−{-# LANGUAGE DefaultSignatures #-}
4+{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
7−{-# LANGUAGE GADTs #-}
7+{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
9−{-# LANGUAGE NamedFieldPuns #-}
9+{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PatternGuards #-}
11−{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
12−{-# LANGUAGE RecordWildCards #-}
12+{-# LANGUAGE RecordWildCards #-}
13−{-# LANGUAGE ScopedTypeVariables #-}
13+{-# LANGUAGE ScopedTypeVariables #-}
14−{-# LANGUAGE TypeOperators #-}
14+{-# LANGUAGE TypeOperators #-}
15−{-# LANGUAGE TypeSynonymInstances #-}
15+{-# LANGUAGE UndecidableInstances #-}
16−{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ >= 706
19−{-# LANGUAGE PolyKinds #-}
22#include "overlapping-compat.h"
17#include "overlapping-compat.h"
18+#include "incoherent-compat.h"
24-- TODO: Drop this when we remove support for Data.Attoparsec.Number
20-- TODO: Drop this when we remove support for Data.Attoparsec.Number
25{-# OPTIONS_GHC -fno-warn-deprecations #-}
21{-# OPTIONS_GHC -fno-warn-deprecations #-}
27−module Data.Aeson.Types.ToJSON (
23+module Data.Aeson.Types.ToJSON
28 -- * Core JSON classes
25 -- * Core JSON classes
29 ToJSON(..)
26 ToJSON(..)
30 -- * Liftings to unary and binary type constructors
27 -- * Liftings to unary and binary type constructors
@@ -36,7 +33,7 @@ module Data.Aeson.Types.ToJSON (
36 , toEncoding2
33 , toEncoding2
37 -- * Generic JSON classes
34 -- * Generic JSON classes
38 , GToJSON(..)
35 , GToJSON(..)
39− , GToEncoding(..)
36+ , ToArgs(..)
40 , genericToJSON
37 , genericToJSON
41 , genericToEncoding
38 , genericToEncoding
42 , genericLiftToJSON
39 , genericLiftToJSON
@@ -46,87 +43,101 @@ module Data.Aeson.Types.ToJSON (
46 , ToJSONKeyFunction(..)
43 , ToJSONKeyFunction(..)
47 , toJSONKeyText
44 , toJSONKeyText
48 , contramapToJSONKeyFunction
45 , contramapToJSONKeyFunction
49 -- * Object key-value pairs
50 -- * Object key-value pairs
50 , KeyValue(..)
51 , KeyValue(..)
51 -- * Functions needed for documentation
54 -- * Functions needed for documentation
52 -- * Encoding functions
55 -- * Encoding functions
53 , listEncoding
56 , listEncoding
54 , listValue
57 , listValue
58import Prelude.Compat
60import Prelude.Compat
60−import Data.Aeson.Encoding.Internal (Encoding, Encoding', Series, dict,
62+import Control.Applicative (Const(..))
61− emptyArray_, tuple, (>*<), (><))
63+import Control.Monad.ST (ST)
64+import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65+import Data.Aeson.Encoding.Internal ((>*<))
62import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
66import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
63−import Data.Aeson.Types.Generic
67+import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
64import Data.Aeson.Types.Internal
68import Data.Aeson.Types.Internal
65−
69+import Data.Attoparsec.Number (Number(..))
66−-- We need internal here for generic deriving
70+import Data.Bits (unsafeShiftR)
67−import qualified Data.Aeson.Encoding.Internal as E
71+import Data.DList (DList)
68−
72+import Data.Fixed (Fixed, HasResolution, Nano)
69−import Control.Applicative (Const (..))
73+import Data.Foldable (toList)
70−import Control.Monad.ST (ST)
74+import Data.Functor.Compose (Compose(..))
71−import Data.Attoparsec.Number (Number (..))
75+import Data.Functor.Contravariant (Contravariant (..))
72−import Data.Bits (unsafeShiftR)
76+import Data.Functor.Identity (Identity(..))
73−import Data.DList (DList)
77+import Data.Functor.Product (Product(..))
74−import Data.Fixed (Fixed, HasResolution)
78+import Data.Functor.Sum (Sum(..))
75−import Data.Foldable (toList)
79+import Data.Int (Int16, Int32, Int64, Int8)
76−import Data.Functor.Compose (Compose (..))
80+import Data.List (intersperse)
77−import Data.Functor.Identity (Identity (..))
81+import Data.List.NonEmpty (NonEmpty(..))
78−import Data.Functor.Product (Product (..))
82+import Data.Semigroup ((<>))
79−import Data.Functor.Sum (Sum (..))
83+import Data.Proxy (Proxy(..))
80−import Data.Int (Int16, Int32, Int64, Int8)
84+import Data.Ratio (Ratio, denominator, numerator)
81−import Data.List (intersperse)
85+import Data.Scientific (Scientific)
82−import Data.List.NonEmpty (NonEmpty (..))
86+import Data.Tagged (Tagged(..))
83−import Data.Monoid (Dual (..), First (..), Last (..), (<>))
87+import Data.Text (Text, pack)
84−import Data.Proxy (Proxy (..))
88+import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
85−import Data.Ratio (Ratio, denominator, numerator)
89+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
86−import Data.Scientific (Scientific)
90+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
87−import Data.Tagged (Tagged (..))
91+import Data.Time.Clock.System.Compat (SystemTime (..))
88−import Data.Text (Text, pack)
92+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
89−import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay,
93+import Data.Vector (Vector)
90− UTCTime, ZonedTime)
94+import Data.Version (Version, showVersion)
91−import Data.Time.Format (FormatTime, formatTime)
95+import Data.Void (Void, absurd)
92−import Data.Time.Locale.Compat (defaultTimeLocale)
96+import Data.Word (Word16, Word32, Word64, Word8)
93−import Data.Vector (Vector)
97+import Foreign.Storable (Storable)
94−import Data.Version (Version, showVersion)
98+import Foreign.C.Types (CTime (..))
95−import Data.Word (Word16, Word32, Word64, Word8)
96−import Foreign.Storable (Storable)
97import GHC.Generics
99import GHC.Generics
98−import Numeric.Natural (Natural)
100+import Numeric.Natural (Natural)
99−
101+import qualified Data.Aeson.Encoding as E
100−import qualified Data.ByteString as S
102+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
101−import qualified Data.ByteString.Lazy as L
103+import qualified Data.ByteString.Lazy as L
102−import qualified Data.DList as DList
104+import qualified Data.DList as DList
103−import qualified Data.HashMap.Strict as H
105+import qualified Data.HashMap.Strict as H
104−import qualified Data.HashSet as HashSet
106+import qualified Data.HashSet as HashSet
105−import qualified Data.IntMap as IntMap
107+import qualified Data.IntMap as IntMap
106−import qualified Data.IntSet as IntSet
108+import qualified Data.IntSet as IntSet
107−import qualified Data.List.NonEmpty as NE
109+import qualified Data.List.NonEmpty as NE
108−import qualified Data.Map as M
110+import qualified Data.Map as M
109−import qualified Data.Scientific as Scientific
111+import qualified Data.Monoid as Monoid
110−import qualified Data.Sequence as Seq
112+import qualified Data.Scientific as Scientific
111−import qualified Data.Set as Set
113+import qualified Data.Semigroup as Semigroup
112−import qualified Data.Text as T
114+import qualified Data.Sequence as Seq
113−import qualified Data.Text.Encoding as T
115+import qualified Data.Set as Set
114−import qualified Data.Text.Lazy as LT
116+import qualified Data.Text as T
115−import qualified Data.Tree as Tree
117+import qualified Data.Text.Encoding as T
116−import qualified Data.Vector as V
118+import qualified Data.Text.Lazy as LT
117−import qualified Data.Vector.Generic as VG
119+import qualified Data.Tree as Tree
118−import qualified Data.Vector.Mutable as VM
120+import qualified Data.UUID.Types as UUID
121+import qualified Data.Vector as V
122+import qualified Data.Vector.Generic as VG
123+import qualified Data.Vector.Mutable as VM
119import qualified Data.Vector.Primitive as VP
124import qualified Data.Vector.Primitive as VP
120−import qualified Data.Vector.Storable as VS
125+import qualified Data.Vector.Storable as VS
121−import qualified Data.Vector.Unboxed as VU
126+import qualified Data.Vector.Unboxed as VU
123−#if !(MIN_VERSION_bytestring(0,10,0))
128+import qualified Data.Aeson.Encoding.Builder as EB
124−import Foreign.ForeignPtr (withForeignPtr)
129+import qualified Data.ByteString.Builder as B
125−import Foreign.Marshal.Utils (copyBytes)
126−import Foreign.Ptr (plusPtr)
128−import qualified Data.ByteString.Internal as S
131+import qualified GHC.Exts as Exts
129−import qualified Data.ByteString.Lazy.Internal as L
132+import qualified Data.Primitive.Array as PM
133+import qualified Data.Primitive.SmallArray as PM
134+import qualified Data.Primitive.Types as PM
136+#if MIN_VERSION_primitive(0,6,4)
137+#if !MIN_VERSION_primitive(0,7,0)
138+import qualified Data.Primitive.UnliftedArray as PM
140+import qualified Data.Primitive.PrimArray as PM
132toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
@@ -145,51 +156,53 @@ realFloatToJSON d
146-- | Class of generic representation types that can be converted to
157-- | Class of generic representation types that can be converted to
148−class GToJSON arity f where
159+class GToJSON enc arity f where
149 -- | This method (applied to 'defaultOptions') is used as the
160 -- | This method (applied to 'defaultOptions') is used as the
150− -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
161+ -- default generic implementation of 'toJSON'
151− -- or 'liftToJSON' (if the @arity@ is 'One').
162+ -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
152− gToJSON :: Options -> Proxy arity
163+ -- and 'liftToJSON' (if the @arity@ is 'One').
153− -> (a -> Value) -> ([a] -> Value) -> f a -> Value
164+ --
154−
165+ -- It also provides a generic implementation of 'toEncoding'
155−-- | Class of generic representation types that can be converted to
166+ -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
156−-- a JSON 'Encoding'.
167+ -- and 'liftToEncoding' (if the @arity@ is 'One').
157−class GToEncoding arity f where
168+ gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
158− -- | This method (applied to 'defaultOptions') can be used as the
169+
159− -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
170+-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
160− -- or 'liftToEncoding' (if the @arity@ is 'One').
171+-- function arguments that encode occurrences of the type parameter (for
161− gToEncoding :: Options -> Proxy arity
172+-- 'ToJSON1').
162− -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
173+data ToArgs res arity a where
174+ NoToArgs :: ToArgs res Zero a
175+ To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
164-- | A configurable generic JSON creator. This function applied to
177-- | A configurable generic JSON creator. This function applied to
165-- 'defaultOptions' is used as the default for 'toJSON' when the type
178-- 'defaultOptions' is used as the default for 'toJSON' when the type
166-- is an instance of 'Generic'.
179-- is an instance of 'Generic'.
167−genericToJSON :: (Generic a, GToJSON Zero (Rep a))
180+genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
168 => Options -> a -> Value
181 => Options -> a -> Value
169−genericToJSON opts = gToJSON opts proxyZero undefined undefined . from
182+genericToJSON opts = gToJSON opts NoToArgs . from
171-- | A configurable generic JSON creator. This function applied to
184-- | A configurable generic JSON creator. This function applied to
172-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
185-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
173-- is an instance of 'Generic1'.
186-- is an instance of 'Generic1'.
174−genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
187+genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
175 => Options -> (a -> Value) -> ([a] -> Value)
188 => Options -> (a -> Value) -> ([a] -> Value)
176 -> f a -> Value
189 -> f a -> Value
177−genericLiftToJSON opts tj tjl = gToJSON opts proxyOne tj tjl . from1
190+genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
179-- | A configurable generic JSON encoder. This function applied to
192-- | A configurable generic JSON encoder. This function applied to
180-- 'defaultOptions' is used as the default for 'toEncoding' when the type
193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
181-- is an instance of 'Generic'.
194-- is an instance of 'Generic'.
182−genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
195+genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
183 => Options -> a -> Encoding
196 => Options -> a -> Encoding
184−genericToEncoding opts = gToEncoding opts proxyZero undefined undefined . from
197+genericToEncoding opts = gToJSON opts NoToArgs . from
186-- | A configurable generic JSON encoder. This function applied to
199-- | A configurable generic JSON encoder. This function applied to
187-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
200-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
188-- is an instance of 'Generic1'.
201-- is an instance of 'Generic1'.
189−genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
202+genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
190 => Options -> (a -> Encoding) -> ([a] -> Encoding)
203 => Options -> (a -> Encoding) -> ([a] -> Encoding)
191 -> f a -> Encoding
204 -> f a -> Encoding
192−genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
194-------------------------------------------------------------------------------
207-------------------------------------------------------------------------------
@@ -197,6 +210,9 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
198-- | A type that can be converted to JSON.
211-- | A type that can be converted to JSON.
213+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214+-- to) specify 'toEncoding'.
200-- An example type and instance:
216-- An example type and instance:
@@ -205,10 +221,10 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
206-- data Coord = Coord { x :: Double, y :: Double }
222-- data Coord = Coord { x :: Double, y :: Double }
208−-- instance ToJSON Coord where
224+-- instance 'ToJSON' Coord where
209−-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
211−-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
214-- Instead of manually writing your 'ToJSON' instance, there are two options
230-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -216,17 +232,15 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
217-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
218-- instance at compile time. The generated instance is optimized for your type
234-- instance at compile time. The generated instance is optimized for your type
219−-- so will probably be more efficient than the following two options:
235+-- so it will probably be more efficient than the following option.
221-- * The compiler can provide a default generic implementation for
237-- * The compiler can provide a default generic implementation for
222-- 'toJSON'.
238-- 'toJSON'.
224-- To use the second, simply add a @deriving 'Generic'@ clause to your
240-- To use the second, simply add a @deriving 'Generic'@ clause to your
225−-- datatype and declare a 'ToJSON' instance for your datatype without giving
241+-- datatype and declare a 'ToJSON' instance. If you require nothing other than
226−-- definitions for 'toJSON' or 'toEncoding'.
242+-- 'defaultOptions', it is sufficient to write (and this is the only
227−--
243+-- alternative where the default 'toJSON' implementation is sufficient):
228−-- For example, the previous example can be simplified to a more
232-- {-\# LANGUAGE DeriveGeneric \#-}
246-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -235,35 +249,46 @@ genericLiftToEncoding opts te tel = gToEncoding opts proxyOne te tel . from1
236-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
238−-- instance ToJSON Coord where
252+-- instance 'ToJSON' Coord where
239−-- toEncoding = 'genericToEncoding' 'defaultOptions'
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
242−-- Why do we provide an implementation for 'toEncoding' here? The
256+-- If on the other hand you wish to customize the generic decoding, you have
243−-- 'toEncoding' function is a relatively new addition to this class.
257+-- to implement both methods:
244−-- To allow users of older versions of this library to upgrade without
245−-- having to edit all of their instances or encounter surprising
246−-- incompatibilities, the default implementation of 'toEncoding' uses
247−-- 'toJSON'. This produces correct results, but since it performs an
248−-- intermediate conversion to a 'Value', it will be less efficient
249−-- than directly emitting an 'Encoding'. Our one-liner definition of
250−-- 'toEncoding' above bypasses the intermediate 'Value'.
252−-- If @DefaultSignatures@ doesn't give exactly the results you want,
253−-- you can customize the generic encoding with only a tiny amount of
254−-- effort, using 'genericToJSON' and 'genericToEncoding' with your
255−-- preferred 'Options':
258−-- instance ToJSON Coord where
260+-- customOptions = 'defaultOptions'
259−-- toJSON = 'genericToJSON' 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
260−-- toEncoding = 'genericToEncoding' 'defaultOptions'
262+-- }
264+-- instance 'ToJSON' Coord where
265+-- 'toJSON' = 'genericToJSON' customOptions
266+-- 'toEncoding' = 'genericToEncoding' customOptions
269+-- Previous versions of this library only had the 'toJSON' method. Adding
270+-- 'toEncoding' had two reasons:
272+-- 1. toEncoding is more efficient for the common case that the output of
273+-- 'toJSON' is directly serialized to a @ByteString@.
274+-- Further, expressing either method in terms of the other would be
277+-- 2. The choice of defaults allows a smooth transition for existing users:
278+-- Existing instances that do not define 'toEncoding' still
279+-- compile and have the correct semantics. This is ensured by making
280+-- the default implementation of 'toEncoding' use 'toJSON'. This produces
281+-- correct results, but since it performs an intermediate conversion to a
282+-- 'Value', it will be less efficient than directly emitting an 'Encoding'.
283+-- (this also means that specifying nothing more than
284+-- @instance ToJSON Coord@ would be sufficient as a generically decoding
285+-- instance, but there probably exists no good reason to not specify
286+-- 'toEncoding' in new instances.)
262class ToJSON a where
287class ToJSON a where
263 -- | Convert a Haskell value to a JSON-friendly intermediate type.
288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
264 toJSON :: a -> Value
289 toJSON :: a -> Value
266− default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
267 toJSON = genericToJSON defaultOptions
292 toJSON = genericToJSON defaultOptions
269 -- | Encode a Haskell value as JSON.
294 -- | Encode a Haskell value as JSON.
@@ -280,8 +305,8 @@ class ToJSON a where
280 -- extension, and then have GHC generate a method body as follows.
305 -- extension, and then have GHC generate a method body as follows.
283− -- instance ToJSON Coord where
308+ -- instance 'ToJSON' Coord where
284− -- toEncoding = 'genericToEncoding' 'defaultOptions'
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
287 toEncoding :: a -> Encoding
312 toEncoding :: a -> Encoding
@@ -313,6 +338,13 @@ instance KeyValue Pair where
313 name .= value = (name, toJSON value)
338 name .= value = (name, toJSON value)
314 {-# INLINE (.=) #-}
339 {-# INLINE (.=) #-}
341+-- | Constructs a singleton 'H.HashMap'. For calling functions that
342+-- demand an 'Object' for constructing objects. To be used in
343+-- conjunction with 'mconcat'. Prefer to use 'object' where possible.
344+instance KeyValue Object where
345+ name .= value = H.singleton name (toJSON value)
316-------------------------------------------------------------------------------
348-------------------------------------------------------------------------------
317-- Classes and types for map keys
349-- Classes and types for map keys
318-------------------------------------------------------------------------------
350-------------------------------------------------------------------------------
@@ -370,7 +402,7 @@ instance KeyValue Pair where
370-- newtype wrapper around 'Text'. The recommended approach is to use
402-- newtype wrapper around 'Text'. The recommended approach is to use
371-- generalized newtype deriving:
403-- generalized newtype deriving:
373−-- > newtype RecordId = RecordId { getRecordId :: Text}
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
374-- > deriving (Eq,Ord,ToJSONKey)
406-- > deriving (Eq,Ord,ToJSONKey)
376-- Then we may write:
408-- Then we may write:
@@ -385,8 +417,18 @@ instance KeyValue Pair where
386-- It is possible to get the 'ToJSONKey' instance for free as we did
418-- It is possible to get the 'ToJSONKey' instance for free as we did
387-- with 'Foo'. However, in this case, we have a natural way to go to
419-- with 'Foo'. However, in this case, we have a natural way to go to
388−-- and from 'Text' that does not require any escape sequences. So, in
420+-- and from 'Text' that does not require any escape sequences. So
389−-- this example, 'ToJSONKeyText' will be used instead of 'ToJSONKeyValue'.
421+-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
422+-- as objects instead of arrays of pairs. This instance may be
423+-- implemented using generics as follows:
426+-- instance 'ToJSONKey' Color where
427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
430+-- === __Low-level implementations__
390-- The 'Show' instance can be used to help write 'ToJSONKey':
432-- The 'Show' instance can be used to help write 'ToJSONKey':
392-- > instance ToJSONKey Color where
434-- > instance ToJSONKey Color where
@@ -461,16 +503,42 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
461 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
462 tot = T.dropAround (== '"')
504 tot = T.dropAround (== '"')
463 . T.decodeLatin1
505 . T.decodeLatin1
464− . lazyToStrictByteString
506+ . L.toStrict
465 . E.encodingToLazyByteString
507 . E.encodingToLazyByteString
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
468-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
513-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
469contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
470contramapToJSONKeyFunction h x = case x of
515contramapToJSONKeyFunction h x = case x of
471 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
516 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
472 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
517 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
519+-- 'toJSONKey' for 'Generic' types.
520+-- Deriving is supported for enumeration types, i.e. the sums of nullary
521+-- constructors. The names of constructors will be used as keys for JSON
524+-- See also 'genericFromJSONKey'.
529+-- data Color = Red | Green | Blue
530+-- deriving 'Generic'
532+-- instance 'ToJSONKey' Color where
533+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
535+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
536+ => JSONKeyOptions -> ToJSONKeyFunction a
537+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)
539+class GetConName f => GToJSONKey f
540+instance GetConName f => GToJSONKey f
474-------------------------------------------------------------------------------
542-------------------------------------------------------------------------------
475-- Lifings of FromJSON and ToJSON to unary and binary type constructors
543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
476-------------------------------------------------------------------------------
544-------------------------------------------------------------------------------
@@ -483,7 +551,7 @@ contramapToJSONKeyFunction h x = case x of
484-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
552-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
485-- instance at compile time. The generated instance is optimized for your type
553-- instance at compile time. The generated instance is optimized for your type
486−-- so will probably be more efficient than the following two options:
554+-- so it will probably be more efficient than the following option.
488-- * The compiler can provide a default generic implementation for
556-- * The compiler can provide a default generic implementation for
489-- 'toJSON1'.
557-- 'toJSON1'.
@@ -501,23 +569,29 @@ contramapToJSONKeyFunction h x = case x of
502-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
570-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
504−-- instance ToJSON a => ToJSON1 (Pair a)
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
507−-- If @DefaultSignatures@ doesn't give exactly the results you want,
575+-- If the default implementation doesn't give exactly the results you want,
508-- you can customize the generic encoding with only a tiny amount of
576-- you can customize the generic encoding with only a tiny amount of
509-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
577-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
510-- your preferred 'Options':
578-- your preferred 'Options':
513−-- instance ToJSON a => ToJSON1 (Pair a) where
581+-- customOptions = 'defaultOptions'
514−-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
515−-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
583+-- }
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
590+-- See also 'ToJSON'.
517class ToJSON1 f where
591class ToJSON1 f where
518 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
520− default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
521 => (a -> Value) -> ([a] -> Value) -> f a -> Value
595 => (a -> Value) -> ([a] -> Value) -> f a -> Value
522 liftToJSON = genericLiftToJSON defaultOptions
596 liftToJSON = genericLiftToJSON defaultOptions
@@ -526,7 +600,7 @@ class ToJSON1 f where
527 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
529− default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
530 => (a -> Encoding) -> ([a] -> Encoding)
604 => (a -> Encoding) -> ([a] -> Encoding)
531 -> f a -> Encoding
605 -> f a -> Encoding
532 liftToEncoding = genericLiftToEncoding defaultOptions
606 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -574,9 +648,25 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
574-- Encoding functions
648-- Encoding functions
575-------------------------------------------------------------------------------
649-------------------------------------------------------------------------------
651+-- | Helper function to use with 'liftToEncoding'.
652+-- Useful when writing own 'ToJSON1' instances.
655+-- newtype F a = F [a]
657+-- -- This instance encodes 'String' as an array of chars
658+-- instance 'ToJSON1' F where
659+-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660+-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
662+-- instance 'Data.Aeson.FromJSON.FromJSON1' F where
663+-- 'Data.Aeson.FromJSON.liftParseJSON' p _ v = F \<$\> 'Data.Aeson.FromJSON.liftParseJSON' p ('Data.Aeson.FromJSON.listParser' p) v
577listEncoding :: (a -> Encoding) -> [a] -> Encoding
665listEncoding :: (a -> Encoding) -> [a] -> Encoding
578listEncoding = E.list
666listEncoding = E.list
667+{-# INLINE listEncoding #-}
669+-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
580listValue :: (a -> Value) -> [a] -> Value
670listValue :: (a -> Value) -> [a] -> Value
581listValue f = Array . V.fromList . map f
671listValue f = Array . V.fromList . map f
582{-# INLINE listValue #-}
672{-# INLINE listValue #-}
@@ -595,6 +685,11 @@ instance ToJSON1 [] where
595 {-# INLINE liftToEncoding #-}
685 {-# INLINE liftToEncoding #-}
597instance (ToJSON a) => ToJSON [a] where
687instance (ToJSON a) => ToJSON [a] where
688+ {-# SPECIALIZE instance ToJSON String #-}
689+ {-# SPECIALIZE instance ToJSON [String] #-}
690+ {-# SPECIALIZE instance ToJSON [Array] #-}
691+ {-# SPECIALIZE instance ToJSON [Object] #-}
598 toJSON = toJSON1
693 toJSON = toJSON1
599 {-# INLINE toJSON #-}
694 {-# INLINE toJSON #-}
@@ -605,282 +700,260 @@ instance (ToJSON a) => ToJSON [a] where
605-- Generic toJSON / toEncoding
700-- Generic toJSON / toEncoding
606-------------------------------------------------------------------------------
701-------------------------------------------------------------------------------
703+instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
704+ -- Meta-information, which is not handled elsewhere, is ignored:
705+ gToJSON opts targs = gToJSON opts targs . unM1
706+ {-# INLINE gToJSON #-}
708+instance GToJSON enc One Par1 where
709+ -- Direct occurrences of the last type parameter are encoded with the
710+ -- function passed in as an argument:
711+ gToJSON _opts (To1Args tj _) = tj . unPar1
712+ {-# INLINE gToJSON #-}
714+instance ( ConsToJSON enc arity a
715+ , AllNullary (C1 c a) allNullary
716+ , SumToJSON enc arity (C1 c a) allNullary
717+ ) => GToJSON enc arity (D1 d (C1 c a)) where
718+ -- The option 'tagSingleConstructors' determines whether to wrap
719+ -- a single-constructor type.
721+ | tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
722+ . sumToJSON opts targs
724+ | otherwise = consToJSON opts targs . unM1 . unM1
725+ {-# INLINE gToJSON #-}
727+instance (ConsToJSON enc arity a) => GToJSON enc arity (C1 c a) where
728+ -- Constructors need to be encoded differently depending on whether they're
729+ -- a record or not. This distinction is made by 'consToJSON':
730+ gToJSON opts targs = consToJSON opts targs . unM1
731+ {-# INLINE gToJSON #-}
733+instance ( AllNullary (a :+: b) allNullary
734+ , SumToJSON enc arity (a :+: b) allNullary
735+ ) => GToJSON enc arity (a :+: b)
737+ -- If all constructors of a sum datatype are nullary and the
738+ -- 'allNullaryToStringTag' option is set they are encoded to
739+ -- strings. This distinction is made by 'sumToJSON':
740+ gToJSON opts targs = (unTagged :: Tagged allNullary enc -> enc)
741+ . sumToJSON opts targs
742+ {-# INLINE gToJSON #-}
608--------------------------------------------------------------------------------
744--------------------------------------------------------------------------------
609-- Generic toJSON
745-- Generic toJSON
611−instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
747+-- Note: Refactoring 'ToJSON a' to 'ToJSON enc a' (and 'ToJSON1' similarly) is
612− -- Meta-information, which is not handled elsewhere, is ignored:
748+-- possible but makes error messages a bit harder to understand for missing
613− gToJSON opts pa tj tjl = gToJSON opts pa tj tjl . unM1
749+-- instances.
615−instance (ToJSON a) => GToJSON arity (K1 i a) where
751+instance GToJSON Value arity V1 where
616− -- Constant values are encoded using their ToJSON instance:
752+ -- Empty values do not exist, which makes the job of formatting them
617− gToJSON _opts _ _ _ = toJSON . unK1
753+ -- rather easy:
754+ gToJSON _ _ x = x `seq` error "case: V1"
755+ {-# INLINE gToJSON #-}
619−instance GToJSON One Par1 where
757+instance ToJSON a => GToJSON Value arity (K1 i a) where
620− -- Direct occurrences of the last type parameter are encoded with the
758+ -- Constant values are encoded using their ToJSON instance:
621− -- function passed in as an argument:
759+ gToJSON _opts _ = toJSON . unK1
622− gToJSON _opts _ tj _ = tj . unPar1
760+ {-# INLINE gToJSON #-}
624−instance (ToJSON1 f) => GToJSON One (Rec1 f) where
762+instance ToJSON1 f => GToJSON Value One (Rec1 f) where
625 -- Recursive occurrences of the last type parameter are encoded using their
763 -- Recursive occurrences of the last type parameter are encoded using their
626 -- ToJSON1 instance:
764 -- ToJSON1 instance:
627− gToJSON _opts _ tj tjl = liftToJSON tj tjl . unRec1
765+ gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766+ {-# INLINE gToJSON #-}
629−instance GToJSON arity U1 where
768+instance GToJSON Value arity U1 where
630 -- Empty constructors are encoded to an empty array:
769 -- Empty constructors are encoded to an empty array:
631− gToJSON _opts _ _ _ _ = emptyArray
770+ gToJSON _opts _ _ = emptyArray
632−
771+ {-# INLINE gToJSON #-}
633−instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
634− -- Constructors need to be encoded differently depending on whether they're
635− -- a record or not. This distinction is made by 'consToJSON':
636− gToJSON opts pa tj tjl = consToJSON opts pa tj tjl . unM1
638instance ( WriteProduct arity a, WriteProduct arity b
773instance ( WriteProduct arity a, WriteProduct arity b
639 , ProductSize a, ProductSize b
774 , ProductSize a, ProductSize b
640− ) => GToJSON arity (a :*: b) where
775+ ) => GToJSON Value arity (a :*: b)
641 -- Products are encoded to an array. Here we allocate a mutable vector of
777 -- Products are encoded to an array. Here we allocate a mutable vector of
642 -- the same size as the product and write the product's elements to it using
778 -- the same size as the product and write the product's elements to it using
643 -- 'writeProduct':
779 -- 'writeProduct':
644− gToJSON opts pa tj tjl p =
780+ gToJSON opts targs p =
645 Array $ V.create $ do
781 Array $ V.create $ do
646 mv <- VM.unsafeNew lenProduct
782 mv <- VM.unsafeNew lenProduct
647− writeProduct opts pa mv 0 lenProduct tj tjl p
783+ writeProduct opts targs mv 0 lenProduct p
648 return mv
784 return mv
650 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
651 productSize
787 productSize
788+ {-# INLINE gToJSON #-}
653−instance ( AllNullary (a :+: b) allNullary
790+instance ( ToJSON1 f
654− , SumToJSON arity (a :+: b) allNullary
791+ , GToJSON Value One g
655− ) => GToJSON arity (a :+: b) where
792+ ) => GToJSON Value One (f :.: g)
656− -- If all constructors of a sum datatype are nullary and the
793+ where
657− -- 'allNullaryToStringTag' option is set they are encoded to
658− -- strings. This distinction is made by 'sumToJSON':
659− gToJSON opts pa tj tjl = (unTagged :: Tagged allNullary Value -> Value)
660− . sumToJSON opts pa tj tjl
662−instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
663 -- If an occurrence of the last type parameter is nested inside two
794 -- If an occurrence of the last type parameter is nested inside two
664 -- composed types, it is encoded by using the outermost type's ToJSON1
795 -- composed types, it is encoded by using the outermost type's ToJSON1
665 -- instance to generically encode the innermost type:
796 -- instance to generically encode the innermost type:
666− gToJSON opts pa tj tjl =
797+ gToJSON opts targs =
667− let gtj = gToJSON opts pa tj tjl in
798+ let gtj = gToJSON opts targs in
668 liftToJSON gtj (listValue gtj) . unComp1
799 liftToJSON gtj (listValue gtj) . unComp1
800+ {-# INLINE gToJSON #-}
670--------------------------------------------------------------------------------
802--------------------------------------------------------------------------------
671-- Generic toEncoding
803-- Generic toEncoding
673−instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
805+instance ToJSON a => GToJSON Encoding arity (K1 i a) where
674− -- Meta-information, which is not handled elsewhere, is ignored:
675− gToEncoding opts pa te tel = gToEncoding opts pa te tel . unM1
677−instance (ToJSON a) => GToEncoding arity (K1 i a) where
678 -- Constant values are encoded using their ToJSON instance:
806 -- Constant values are encoded using their ToJSON instance:
679− gToEncoding _opts _ _ _ = toEncoding . unK1
807+ gToJSON _opts _ = toEncoding . unK1
680−
808+ {-# INLINE gToJSON #-}
681−instance GToEncoding One Par1 where
682− -- Direct occurrences of the last type parameter are encoded with the
683− -- function passed in as an argument:
684− gToEncoding _opts _ te _ = te . unPar1
686−instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
810+instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
687 -- Recursive occurrences of the last type parameter are encoded using their
811 -- Recursive occurrences of the last type parameter are encoded using their
688 -- ToEncoding1 instance:
812 -- ToEncoding1 instance:
689− gToEncoding _opts _ te tel = liftToEncoding te tel . unRec1
813+ gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814+ {-# INLINE gToJSON #-}
691−instance GToEncoding arity U1 where
816+instance GToJSON Encoding arity U1 where
692 -- Empty constructors are encoded to an empty array:
817 -- Empty constructors are encoded to an empty array:
693− gToEncoding _opts _ _ _ _ = E.emptyArray_
818+ gToJSON _opts _ _ = E.emptyArray_
694−
819+ {-# INLINE gToJSON #-}
695−instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
696− -- Constructors need to be encoded differently depending on whether they're
697− -- a record or not. This distinction is made by 'consToEncoding':
698− gToEncoding opts pa te tel = consToEncoding opts pa te tel . unM1
700instance ( EncodeProduct arity a
821instance ( EncodeProduct arity a
701 , EncodeProduct arity b
822 , EncodeProduct arity b
702− ) => GToEncoding arity (a :*: b) where
823+ ) => GToJSON Encoding arity (a :*: b)
703 -- Products are encoded to an array. Here we allocate a mutable vector of
825 -- Products are encoded to an array. Here we allocate a mutable vector of
704 -- the same size as the product and write the product's elements to it using
826 -- the same size as the product and write the product's elements to it using
705 -- 'encodeProduct':
827 -- 'encodeProduct':
706− gToEncoding opts pa te tel p = E.tuple $ encodeProduct opts pa te tel p
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
707−
829+ {-# INLINE gToJSON #-}
708−instance ( AllNullary (a :+: b) allNullary
709− , SumToEncoding arity (a :+: b) allNullary
710− ) => GToEncoding arity (a :+: b) where
711− -- If all constructors of a sum datatype are nullary and the
712− -- 'allNullaryToStringTag' option is set they are encoded to
713− -- strings. This distinction is made by 'sumToEncoding':
714− gToEncoding opts pa te tel
715− = (unTagged :: Tagged allNullary Encoding -> Encoding)
716− . sumToEncoding opts pa te tel
718−instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
831+instance ( ToJSON1 f
832+ , GToJSON Encoding One g
833+ ) => GToJSON Encoding One (f :.: g)
719 -- If an occurrence of the last type parameter is nested inside two
835 -- If an occurrence of the last type parameter is nested inside two
720 -- composed types, it is encoded by using the outermost type's ToJSON1
836 -- composed types, it is encoded by using the outermost type's ToJSON1
721 -- instance to generically encode the innermost type:
837 -- instance to generically encode the innermost type:
722− gToEncoding opts pa te tel =
838+ gToJSON opts targs =
723− let gte = gToEncoding opts pa te tel in
839+ let gte = gToJSON opts targs in
724 liftToEncoding gte (listEncoding gte) . unComp1
840 liftToEncoding gte (listEncoding gte) . unComp1
841+ {-# INLINE gToJSON #-}
726--------------------------------------------------------------------------------
843--------------------------------------------------------------------------------
728−class SumToJSON arity f allNullary where
845+class SumToJSON enc arity f allNullary where
729− sumToJSON :: Options -> Proxy arity
846+ sumToJSON :: Options -> ToArgs enc arity a
730− -> (a -> Value) -> ([a] -> Value)
847+ -> f a -> Tagged allNullary enc
731− -> f a -> Tagged allNullary Value
848+
732−
849+instance ( GetConName f
733−instance ( GetConName f
850+ , FromString enc
734− , TaggedObjectPairs arity f
851+ , TaggedObject enc arity f
735− , ObjectWithSingleFieldObj arity f
852+ , SumToJSON' ObjectWithSingleField enc arity f
736− , TwoElemArrayObj arity f
853+ , SumToJSON' TwoElemArray enc arity f
737− ) => SumToJSON arity f True where
854+ , SumToJSON' UntaggedValue enc arity f
738− sumToJSON opts pa tj tjl
855+ ) => SumToJSON enc arity f True
739− | allNullaryToStringTag opts = Tagged . String . pack
856+ where
857+ sumToJSON opts targs
858+ | allNullaryToStringTag opts = Tagged . fromString
740 . constructorTagModifier opts . getConName
859 . constructorTagModifier opts . getConName
741− | otherwise = Tagged . nonAllNullarySumToJSON opts pa tj tjl
860+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs
743−instance ( TwoElemArrayObj arity f
744− , TaggedObjectPairs arity f
745− , ObjectWithSingleFieldObj arity f
746− ) => SumToJSON arity f False where
747− sumToJSON opts pa tj tjl = Tagged . nonAllNullarySumToJSON opts pa tj tjl
749−nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
750− , TaggedObjectPairs arity f
751− , ObjectWithSingleFieldObj arity f
752− ) => Options -> Proxy arity
753− -> (a -> Value) -> ([a] -> Value)
755−nonAllNullarySumToJSON opts pa tj tjl =
756− case sumEncoding opts of
758− object . taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl
759− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts pa tj tjl
760− TwoElemArray -> Array . twoElemArrayObj opts pa tj tjl
762−--------------------------------------------------------------------------------
862+instance ( TaggedObject enc arity f
763−
863+ , SumToJSON' ObjectWithSingleField enc arity f
764−class SumToEncoding arity f allNullary where
864+ , SumToJSON' TwoElemArray enc arity f
765− sumToEncoding :: Options -> Proxy arity
865+ , SumToJSON' UntaggedValue enc arity f
766− -> (a -> Encoding) -> ([a] -> Encoding)
866+ ) => SumToJSON enc arity f False
767− -> f a -> Tagged allNullary Encoding
867+ where
768−
868+ sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
769−instance ( GetConName f
869+
770− , TaggedObjectEnc arity f
870+nonAllNullarySumToJSON :: ( TaggedObject enc arity f
771− , ObjectWithSingleFieldEnc arity f
871+ , SumToJSON' ObjectWithSingleField enc arity f
772− , TwoElemArrayEnc arity f
872+ , SumToJSON' TwoElemArray enc arity f
773− ) => SumToEncoding arity f True where
873+ , SumToJSON' UntaggedValue enc arity f
774− sumToEncoding opts pa te tel
874+ ) => Options -> ToArgs enc arity a
775− | allNullaryToStringTag opts = Tagged . toEncoding .
875+ -> f a -> enc
776− constructorTagModifier opts . getConName
876+nonAllNullarySumToJSON opts targs =
777− | otherwise = Tagged . nonAllNullarySumToEncoding opts pa te tel
779−instance ( TwoElemArrayEnc arity f
780− , TaggedObjectEnc arity f
781− , ObjectWithSingleFieldEnc arity f
782− ) => SumToEncoding arity f False where
783− sumToEncoding opts pa te tel = Tagged . nonAllNullarySumToEncoding opts pa te tel
785−nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
786− , TaggedObjectEnc arity f
787− , ObjectWithSingleFieldEnc arity f
788− ) => Options -> Proxy arity
789− -> (a -> Encoding) -> ([a] -> Encoding)
791−nonAllNullarySumToEncoding opts pa te tel =
792 case sumEncoding opts of
877 case sumEncoding opts of
793 TaggedObject{..} ->
879 TaggedObject{..} ->
794− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel
880+ taggedObject opts targs tagFieldName contentsFieldName
795− ObjectWithSingleField -> objectWithSingleFieldEnc opts pa te tel
796− TwoElemArray -> twoElemArrayEnc opts pa te tel
798−--------------------------------------------------------------------------------
882+ ObjectWithSingleField ->
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
800−class TaggedObjectPairs arity f where
886+ TwoElemArray ->
801− taggedObjectPairs :: Options -> Proxy arity
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
802− -> String -> String
888+ . sumToJSON' opts targs
803− -> (a -> Value) -> ([a] -> Value)
806−instance ( TaggedObjectPairs arity a
807− , TaggedObjectPairs arity b
808− ) => TaggedObjectPairs arity (a :+: b) where
809− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (L1 x) =
810− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
811− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl (R1 x) =
812− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl x
814−instance ( IsRecord a isRecord
815− , TaggedObjectPairs' arity a isRecord
817− ) => TaggedObjectPairs arity (C1 c a) where
818− taggedObjectPairs opts pa tagFieldName contentsFieldName tj tjl =
819− (pack tagFieldName .= constructorTagModifier opts
820− (conName (undefined :: t c a p)) :) .
821− (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
822− taggedObjectPairs' opts pa contentsFieldName tj tjl . unM1
824−class TaggedObjectPairs' arity f isRecord where
890+ UntaggedValue ->
825− taggedObjectPairs' :: Options -> Proxy arity
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
826− -> String -> (a -> Value) -> ([a] -> Value)
892+ . sumToJSON' opts targs
827− -> f a -> Tagged isRecord [Pair]
893+
894+--------------------------------------------------------------------------------
829−instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
896+class FromString enc where
830− taggedObjectPairs' _ _ _ _ _ _ = Tagged []
897+ fromString :: String -> enc
832−instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
899+instance FromString Encoding where
833− taggedObjectPairs' opts pa _ tj tjl =
900+ fromString = toEncoding
834− Tagged . toList . recordToPairs opts pa tj tjl
836−instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
902+instance FromString Value where
837− taggedObjectPairs' opts pa contentsFieldName tj tjl =
903+ fromString = String . pack
838− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts pa tj tjl
840--------------------------------------------------------------------------------
905--------------------------------------------------------------------------------
842−class TaggedObjectEnc arity f where
907+class TaggedObject enc arity f where
843− taggedObjectEnc :: Options -> Proxy arity
908+ taggedObject :: Options -> ToArgs enc arity a
844− -> String -> String
909+ -> String -> String
845− -> (a -> Encoding) -> ([a] -> Encoding)
910+ -> f a -> enc
846− -> f a -> Encoding
911+
847−
912+instance ( TaggedObject enc arity a
848−instance ( TaggedObjectEnc arity a
913+ , TaggedObject enc arity b
849− , TaggedObjectEnc arity b
914+ ) => TaggedObject enc arity (a :+: b)
850− ) => TaggedObjectEnc arity (a :+: b) where
915+ where
851− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (L1 x) =
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
852− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
917+ taggedObject opts targs tagFieldName contentsFieldName x
853− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel (R1 x) =
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
854− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel x
919+ taggedObject opts targs tagFieldName contentsFieldName x
856−instance ( IsRecord a isRecord
921+instance ( IsRecord a isRecord
857− , TaggedObjectEnc' arity a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
925+ , KeyValuePair enc pairs
858 , Constructor c
926 , Constructor c
859− ) => TaggedObjectEnc arity (C1 c a) where
927+ ) => TaggedObject enc arity (C1 c a)
860− taggedObjectEnc opts pa tagFieldName contentsFieldName te tel v =
928+ where
861− E.wrapObject $
929+ taggedObject opts targs tagFieldName contentsFieldName =
862− (E.string tagFieldName ><
930+ fromPairs . mappend tag . contents
863− E.colon ><
931+ where
864− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
932+ tag = tagFieldName `pair`
865− ((unTagged :: Tagged isRecord Encoding -> Encoding) .
933+ (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
866− taggedObjectEnc' opts pa contentsFieldName te tel . unM1 $ v)
934+ :: enc)
868−class TaggedObjectEnc' arity f isRecord where
936+ (unTagged :: Tagged isRecord pairs -> pairs) .
869− taggedObjectEnc' :: Options -> Proxy arity
937+ taggedObject' opts targs contentsFieldName . unM1
870− -> String -> (a -> Encoding) -> ([a] -> Encoding)
938+
871− -> f a -> Tagged isRecord Encoding
939+class TaggedObject' enc pairs arity f isRecord where
872−
940+ taggedObject' :: Options -> ToArgs enc arity a
873−instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
941+ -> String -> f a -> Tagged isRecord pairs
874− taggedObjectEnc' _ _ _ _ _ _ = Tagged E.empty
942+
875−
943+instance ( GToJSON enc arity f
876−instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
944+ , KeyValuePair enc pairs
877− taggedObjectEnc' opts pa _ te tel = Tagged . (E.comma ><) . fst
945+ ) => TaggedObject' enc pairs arity f False
878− . recordToEncoding opts pa te tel
946+ where
879−
947+ taggedObject' opts targs contentsFieldName =
880−instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
948+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs
881− taggedObjectEnc' opts pa contentsFieldName te tel =
949+
882− Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
950+instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
883− gToEncoding opts pa te tel
951+ taggedObject' _ _ _ _ = Tagged mempty
953+instance ( RecordToPairs enc pairs arity f
954+ ) => TaggedObject' enc pairs arity f True
956+ taggedObject' opts targs _ = Tagged . recordToPairs opts targs
885--------------------------------------------------------------------------------
958--------------------------------------------------------------------------------
@@ -895,283 +968,242 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
895instance (Constructor c) => GetConName (C1 c a) where
968instance (Constructor c) => GetConName (C1 c a) where
896 getConName = conName
969 getConName = conName
971+-- For genericToJSONKey
972+instance GetConName a => GetConName (D1 d a) where
973+ getConName (M1 x) = getConName x
975+--------------------------------------------------------------------------------
977+-- Reflection of SumEncoding variants
979+data ObjectWithSingleField
898--------------------------------------------------------------------------------
983--------------------------------------------------------------------------------
900−class TwoElemArrayObj arity f where
985+class SumToJSON' s enc arity f where
901− twoElemArrayObj :: Options -> Proxy arity
986+ sumToJSON' :: Options -> ToArgs enc arity a
902− -> (a -> Value) -> ([a] -> Value)
987+ -> f a -> Tagged s enc
903− -> f a -> V.Vector Value
988+
989+instance ( SumToJSON' s enc arity a
990+ , SumToJSON' s enc arity b
991+ ) => SumToJSON' s enc arity (a :+: b)
993+ sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994+ sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
905−instance ( TwoElemArrayObj arity a
996+--------------------------------------------------------------------------------
906− , TwoElemArrayObj arity b
907− ) => TwoElemArrayObj arity (a :+: b) where
908− twoElemArrayObj opts pa tj tjl (L1 x) = twoElemArrayObj opts pa tj tjl x
909− twoElemArrayObj opts pa tj tjl (R1 x) = twoElemArrayObj opts pa tj tjl x
911−instance ( GToJSON arity a
998+instance ( GToJSON Value arity a
912− , ConsToJSON arity a
999+ , ConsToJSON Value arity a
913 , Constructor c
1000 , Constructor c
914− ) => TwoElemArrayObj arity (C1 c a) where
1001+ ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
915− twoElemArrayObj opts pa tj tjl x = V.create $ do
1002+ sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
916 mv <- VM.unsafeNew 2
1003 mv <- VM.unsafeNew 2
917 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1004 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
918 $ conName (undefined :: t c a p)
1005 $ conName (undefined :: t c a p)
919− VM.unsafeWrite mv 1 $ gToJSON opts pa tj tjl x
1006+ VM.unsafeWrite mv 1 $ gToJSON opts targs x
920 return mv
1007 return mv
922--------------------------------------------------------------------------------
1009--------------------------------------------------------------------------------
924−class TwoElemArrayEnc arity f where
1011+instance ( GToJSON Encoding arity a
925− twoElemArrayEnc :: Options -> Proxy arity
1012+ , ConsToJSON Encoding arity a
926− -> (a -> Encoding) -> ([a] -> Encoding)
929−instance ( TwoElemArrayEnc arity a
930− , TwoElemArrayEnc arity b
931− ) => TwoElemArrayEnc arity (a :+: b) where
932− twoElemArrayEnc opts pa te tel (L1 x) = twoElemArrayEnc opts pa te tel x
933− twoElemArrayEnc opts pa te tel (R1 x) = twoElemArrayEnc opts pa te tel x
935−instance ( GToEncoding arity a
936− , ConsToEncoding arity a
937 , Constructor c
1013 , Constructor c
938− ) => TwoElemArrayEnc arity (C1 c a) where
1014+ ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
939− twoElemArrayEnc opts pa te tel x = E.tuple $
1015+ where
940− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
1016+ sumToJSON' opts targs x = Tagged $ E.list id
941− gToEncoding opts pa te tel x
1017+ [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
942−
1018+ , gToJSON opts targs x
943−--------------------------------------------------------------------------------
1019+ ]
945−class ConsToJSON arity f where
946− consToJSON :: Options -> Proxy arity
947− -> (a -> Value) -> ([a] -> Value)
950−class ConsToJSON' arity f isRecord where
951− consToJSON' :: Options -> Proxy arity
952− -> Bool -- ^ Are we a record with one field?
953− -> (a -> Value) -> ([a] -> Value)
954− -> f a -> Tagged isRecord Value
956−instance ( IsRecord f isRecord
957− , ConsToJSON' arity f isRecord
958− ) => ConsToJSON arity f where
959− consToJSON opts pa tj tjl =
960− (unTagged :: Tagged isRecord Value -> Value)
961− . consToJSON' opts pa (isUnary (undefined :: f a)) tj tjl
963−instance (RecordToPairs arity f) => ConsToJSON' arity f True where
964− consToJSON' opts pa isUn tj tjl f = let
965− vals = toList $ recordToPairs opts pa tj tjl f
966− in case (unwrapUnaryRecords opts,isUn,vals) of
967− (True,True,[(_,val)]) -> Tagged val
968− _ -> Tagged $ object vals
970−instance GToJSON arity f => ConsToJSON' arity f False where
971− consToJSON' opts pa _ tj tjl = Tagged . gToJSON opts pa tj tjl
973--------------------------------------------------------------------------------
1021--------------------------------------------------------------------------------
975−class ConsToEncoding arity f where
1023+class ConsToJSON enc arity f where
976− consToEncoding :: Options -> Proxy arity
1024+ consToJSON :: Options -> ToArgs enc arity a
977− -> (a -> Encoding) -> ([a] -> Encoding)
1025+ -> f a -> enc
980−class ConsToEncoding' arity f isRecord where
1027+class ConsToJSON' enc arity f isRecord where
981− consToEncoding' :: Options -> Proxy arity
1028+ consToJSON' :: Options -> ToArgs enc arity a
982− -> Bool -- ^ Are we a record with one field?
1029+ -> f a -> Tagged isRecord enc
983− -> (a -> Encoding) -> ([a] -> Encoding)
984− -> f a -> Tagged isRecord Encoding
986instance ( IsRecord f isRecord
1031instance ( IsRecord f isRecord
987− , ConsToEncoding' arity f isRecord
1032+ , ConsToJSON' enc arity f isRecord
988− ) => ConsToEncoding arity f where
1033+ ) => ConsToJSON enc arity f
989− consToEncoding opts pa te tel =
1034+ where
990− (unTagged :: Tagged isRecord Encoding -> Encoding)
1035+ consToJSON opts targs =
991− . consToEncoding' opts pa (isUnary (undefined :: f a)) te tel
1036+ (unTagged :: Tagged isRecord enc -> enc)
992−
1037+ . consToJSON' opts targs
993−instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
1038+ {-# INLINE consToJSON #-}
994− consToEncoding' opts pa isUn te tel x =
1039+
995− let (enc, mbVal) = recordToEncoding opts pa te tel x
1040+instance OVERLAPPING_
996− in case (unwrapUnaryRecords opts, isUn, mbVal) of
1041+ ( RecordToPairs enc pairs arity (S1 s f)
997− (True, True, Just val) -> Tagged val
1042+ , FromPairs enc pairs
998− _ -> Tagged $ E.wrapObject enc
1043+ , GToJSON enc arity f
999−
1044+ ) => ConsToJSON' enc arity (S1 s f) True
1000−instance GToEncoding arity f => ConsToEncoding' arity f False where
1045+ where
1001− consToEncoding' opts pa _ te tel = Tagged . gToEncoding opts pa te tel
1046+ consToJSON' opts targs
1002−
1047+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1003−--------------------------------------------------------------------------------
1048+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
1004−
1049+ {-# INLINE consToJSON' #-}
1005−class RecordToPairs arity f where
1050+
1006− recordToPairs :: Options -> Proxy arity
1051+instance ( RecordToPairs enc pairs arity f
1007− -> (a -> Value) -> ([a] -> Value)
1052+ , FromPairs enc pairs
1008− -> f a -> DList Pair
1053+ ) => ConsToJSON' enc arity f True
1010−instance ( RecordToPairs arity a
1055+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1011− , RecordToPairs arity b
1056+ {-# INLINE consToJSON' #-}
1012− ) => RecordToPairs arity (a :*: b) where
1013− recordToPairs opts pa tj tjl (a :*: b) = recordToPairs opts pa tj tjl a <>
1014− recordToPairs opts pa tj tjl b
1016−instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
1017− recordToPairs = fieldToPair
1019−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1020− RecordToPairs arity (S1 s (K1 i (Maybe a))) where
1021− recordToPairs opts _ _ _ (M1 k1) | omitNothingFields opts
1022− , K1 Nothing <- k1 = DList.empty
1023− recordToPairs opts pa tj tjl m1 = fieldToPair opts pa tj tjl m1
1025−fieldToPair :: (Selector s, GToJSON arity a)
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1026− => Options -> Proxy arity
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1027− -> (p -> Value) -> ([p] -> Value)
1060+ {-# INLINE consToJSON' #-}
1028− -> S1 s a p -> DList Pair
1029−fieldToPair opts pa tj tjl m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1030− , gToJSON opts pa tj tjl (unM1 m1)
1033--------------------------------------------------------------------------------
1062--------------------------------------------------------------------------------
1035−class RecordToEncoding arity f where
1064+class RecordToPairs enc pairs arity f where
1036 -- 1st element: whole thing
1065 -- 1st element: whole thing
1037 -- 2nd element: in case the record has only 1 field, just the value
1066 -- 2nd element: in case the record has only 1 field, just the value
1038 -- of the field (without the key); 'Nothing' otherwise
1067 -- of the field (without the key); 'Nothing' otherwise
1039− recordToEncoding :: Options -> Proxy arity
1068+ recordToPairs :: Options -> ToArgs enc arity a
1040− -> (a -> Encoding) -> ([a] -> Encoding)
1069+ -> f a -> pairs
1041− -> f a -> (Encoding, Maybe Encoding)
1070+
1042−
1071+instance ( Monoid pairs
1043−instance ( RecordToEncoding arity a
1072+ , RecordToPairs enc pairs arity a
1044− , RecordToEncoding arity b
1073+ , RecordToPairs enc pairs arity b
1045− ) => RecordToEncoding arity (a :*: b) where
1074+ ) => RecordToPairs enc pairs arity (a :*: b)
1046− recordToEncoding opts pa te tel (a :*: b) | omitNothingFields opts =
1075+ where
1047− (E.econcat $ intersperse E.comma $
1076+ recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1048− filter (not . E.nullEncoding)
1077+ pairsOf a `mappend` pairsOf b
1049− [ fst (recordToEncoding opts pa te tel a)
1078+ where
1050− , fst (recordToEncoding opts pa te tel b) ]
1079+ pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1051− , Nothing)
1080+ pairsOf = recordToPairs opts targs
1052− recordToEncoding opts pa te tel (a :*: b) =
1081+ {-# INLINE recordToPairs #-}
1053− (fst (recordToEncoding opts pa te tel a) >< E.comma ><
1082+
1054− fst (recordToEncoding opts pa te tel b),
1083+instance ( Selector s
1055− Nothing)
1084+ , GToJSON enc arity a
1056−
1085+ , KeyValuePair enc pairs
1057−
1086+ ) => RecordToPairs enc pairs arity (S1 s a)
1058−instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1087+ where
1059− recordToEncoding = fieldToEncoding
1088+ recordToPairs = fieldToPair
1060−
1089+ {-# INLINE recordToPairs #-}
1061−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1090+
1062− RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1091+instance INCOHERENT_
1063− recordToEncoding opts _ _ _ (M1 k1) | omitNothingFields opts
1092+ ( Selector s
1064− , K1 Nothing <- k1 = (E.empty, Nothing)
1093+ , GToJSON enc arity (K1 i (Maybe a))
1065− recordToEncoding opts pa te tel m1 = fieldToEncoding opts pa te tel m1
1094+ , KeyValuePair enc pairs
1066−
1095+ , Monoid pairs
1067−fieldToEncoding :: (Selector s, GToEncoding arity a)
1096+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1068− => Options -> Proxy arity
1097+ where
1069− -> (p -> Encoding) -> ([p] -> Encoding)
1098+ recordToPairs opts _ (M1 k1) | omitNothingFields opts
1070− -> S1 s a p -> (Encoding, Maybe Encoding)
1099+ , K1 Nothing <- k1 = mempty
1071−fieldToEncoding opts pa te tel m1 =
1100+ recordToPairs opts targs m1 = fieldToPair opts targs m1
1072− let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1101+ {-# INLINE recordToPairs #-}
1073− valueBuilder = gToEncoding opts pa te tel (unM1 m1)
1102+
1074− in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
1103+instance INCOHERENT_
1105+ , GToJSON enc arity (K1 i (Maybe a))
1106+ , KeyValuePair enc pairs
1108+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1110+ recordToPairs opts targs = recordToPairs opts targs . unwrap
1112+ unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
1113+ unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
1114+ {-# INLINE recordToPairs #-}
1116+fieldToPair :: (Selector s
1117+ , GToJSON enc arity a
1118+ , KeyValuePair enc pairs)
1119+ => Options -> ToArgs enc arity p
1120+ -> S1 s a p -> pairs
1121+fieldToPair opts targs m1 =
1122+ let key = fieldLabelModifier opts (selName m1)
1123+ value = gToJSON opts targs (unM1 m1)
1124+ in key `pair` value
1125+{-# INLINE fieldToPair #-}
1076--------------------------------------------------------------------------------
1127--------------------------------------------------------------------------------
1078class WriteProduct arity f where
1129class WriteProduct arity f where
1079 writeProduct :: Options
1130 writeProduct :: Options
1080− -> Proxy arity
1131+ -> ToArgs Value arity a
1081 -> VM.MVector s Value
1132 -> VM.MVector s Value
1082 -> Int -- ^ index
1133 -> Int -- ^ index
1083 -> Int -- ^ length
1134 -> Int -- ^ length
1087 -> ST s ()
1136 -> ST s ()
1089instance ( WriteProduct arity a
1138instance ( WriteProduct arity a
1090 , WriteProduct arity b
1139 , WriteProduct arity b
1091 ) => WriteProduct arity (a :*: b) where
1140 ) => WriteProduct arity (a :*: b) where
1092− writeProduct opts pa mv ix len tj tjl (a :*: b) = do
1141+ writeProduct opts targs mv ix len (a :*: b) = do
1093− writeProduct opts pa mv ix lenL tj tjl a
1142+ writeProduct opts targs mv ix lenL a
1094− writeProduct opts pa mv ixR lenR tj tjl b
1143+ writeProduct opts targs mv ixR lenR b
1096 lenL = len `unsafeShiftR` 1
1145 lenL = len `unsafeShiftR` 1
1097 lenR = len - lenL
1146 lenR = len - lenL
1098 ixR = ix + lenL
1147 ixR = ix + lenL
1148+ {-# INLINE writeProduct #-}
1100−instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1150+instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1101− writeProduct opts pa mv ix _ tj tjl =
1151+ writeProduct opts targs mv ix _ =
1102− VM.unsafeWrite mv ix . gToJSON opts pa tj tjl
1152+ VM.unsafeWrite mv ix . gToJSON opts targs
1153+ {-# INLINE writeProduct #-}
1104--------------------------------------------------------------------------------
1155--------------------------------------------------------------------------------
1106class EncodeProduct arity f where
1157class EncodeProduct arity f where
1107− encodeProduct :: Options -> Proxy arity
1158+ encodeProduct :: Options -> ToArgs Encoding arity a
1108− -> (a -> Encoding) -> ([a] -> Encoding)
1109 -> f a -> Encoding' E.InArray
1159 -> f a -> Encoding' E.InArray
1111instance ( EncodeProduct arity a
1161instance ( EncodeProduct arity a
1112 , EncodeProduct arity b
1162 , EncodeProduct arity b
1113 ) => EncodeProduct arity (a :*: b) where
1163 ) => EncodeProduct arity (a :*: b) where
1114− encodeProduct opts pa te tel (a :*: b) | omitNothingFields opts =
1164+ encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1115 E.econcat $ intersperse E.comma $
1165 E.econcat $ intersperse E.comma $
1116 filter (not . E.nullEncoding)
1166 filter (not . E.nullEncoding)
1117− [encodeProduct opts pa te tel a, encodeProduct opts pa te tel b]
1167+ [encodeProduct opts targs a, encodeProduct opts targs b]
1118− encodeProduct opts pa te tel (a :*: b) = encodeProduct opts pa te tel a >*<
1168+ encodeProduct opts targs (a :*: b) =
1119− encodeProduct opts pa te tel b
1169+ encodeProduct opts targs a >*<
1170+ encodeProduct opts targs b
1171+ {-# INLINE encodeProduct #-}
1121−instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1173+instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1122− encodeProduct opts pa te tel a = E.retagEncoding $ gToEncoding opts pa te tel a
1174+ encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1175+ {-# INLINE encodeProduct #-}
1124--------------------------------------------------------------------------------
1177--------------------------------------------------------------------------------
1126−class ObjectWithSingleFieldObj arity f where
1179+instance ( GToJSON enc arity a
1127− objectWithSingleFieldObj :: Options -> Proxy arity
1180+ , ConsToJSON enc arity a
1128− -> (a -> Value) -> ([a] -> Value)
1181+ , FromPairs enc pairs
1129− -> f a -> Object
1182+ , KeyValuePair enc pairs
1131−instance ( ObjectWithSingleFieldObj arity a
1132− , ObjectWithSingleFieldObj arity b
1133− ) => ObjectWithSingleFieldObj arity (a :+: b) where
1134− objectWithSingleFieldObj opts pa tj tjl (L1 x) =
1135− objectWithSingleFieldObj opts pa tj tjl x
1136− objectWithSingleFieldObj opts pa tj tjl (R1 x) =
1137− objectWithSingleFieldObj opts pa tj tjl x
1139−instance ( GToJSON arity a
1140− , ConsToJSON arity a
1141 , Constructor c
1183 , Constructor c
1142− ) => ObjectWithSingleFieldObj arity (C1 c a) where
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1143− objectWithSingleFieldObj opts pa tj tjl = H.singleton typ . gToJSON opts pa tj tjl
1185+ where
1186+ sumToJSON' opts targs =
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1145− typ = pack $ constructorTagModifier opts $
1189+ typ = constructorTagModifier opts $
1146 conName (undefined :: t c a p)
1190 conName (undefined :: t c a p)
1148--------------------------------------------------------------------------------
1192--------------------------------------------------------------------------------
1150−class ObjectWithSingleFieldEnc arity f where
1194+instance OVERLAPPABLE_
1151− objectWithSingleFieldEnc :: Options -> Proxy arity
1195+ ( ConsToJSON enc arity a
1152− -> (a -> Encoding) -> ([a] -> Encoding)
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1153− -> f a -> Encoding
1197+ where
1154−
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
1155−instance ( ObjectWithSingleFieldEnc arity a
1199+
1156− , ObjectWithSingleFieldEnc arity b
1200+instance OVERLAPPING_
1157− ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1201+ ( Constructor c
1158− objectWithSingleFieldEnc opts pa te tel (L1 x) =
1202+ , FromString enc
1159− objectWithSingleFieldEnc opts pa te tel x
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1160− objectWithSingleFieldEnc opts pa te tel (R1 x) =
1204+ where
1161− objectWithSingleFieldEnc opts pa te tel x
1205+ sumToJSON' opts _ _ = Tagged . fromString $
1162−
1206+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
1163−instance ( GToEncoding arity a
1164− , ConsToEncoding arity a
1166− ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1167− objectWithSingleFieldEnc opts pa te tel v =
1170− (constructorTagModifier opts
1171− (conName (undefined :: t c a p))) ><
1173− gToEncoding opts pa te tel v ><
1176-------------------------------------------------------------------------------
1208-------------------------------------------------------------------------------
1177-- Instances
1209-- Instances
@@ -1244,6 +1276,13 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1244 toEncoding = toEncoding2
1276 toEncoding = toEncoding2
1245 {-# INLINE toEncoding #-}
1277 {-# INLINE toEncoding #-}
1279+instance ToJSON Void where
1281+ {-# INLINE toJSON #-}
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
1248instance ToJSON Bool where
1287instance ToJSON Bool where
1249 toJSON = Bool
1288 toJSON = Bool
@@ -1429,7 +1468,6 @@ instance ToJSONKey Int64 where
1429 toJSONKey = toJSONKeyTextEnc E.int64Text
1468 toJSONKey = toJSONKeyTextEnc E.int64Text
1430 {-# INLINE toJSONKey #-}
1469 {-# INLINE toJSONKey #-}
1433instance ToJSON Word where
1471instance ToJSON Word where
1434 toJSON = Number . fromIntegral
1472 toJSON = Number . fromIntegral
1435 {-# INLINE toJSON #-}
1473 {-# INLINE toJSON #-}
@@ -1489,6 +1527,12 @@ instance ToJSONKey Word64 where
1489 toJSONKey = toJSONKeyTextEnc E.word64Text
1527 toJSONKey = toJSONKeyTextEnc E.word64Text
1490 {-# INLINE toJSONKey #-}
1528 {-# INLINE toJSONKey #-}
1530+instance ToJSON CTime where
1531+ toJSON (CTime i) = toJSON i
1532+ {-# INLINE toJSON #-}
1534+ toEncoding (CTime i) = toEncoding i
1535+ {-# INLINE toEncoding #-}
1493instance ToJSON Text where
1537instance ToJSON Text where
1494 toJSON = String
1538 toJSON = String
@@ -1603,7 +1647,7 @@ instance (ToJSON a) => ToJSON (Identity a) where
1603 toEncodingList = liftToEncodingList toEncoding toEncodingList
1647 toEncodingList = liftToEncodingList toEncoding toEncodingList
1604 {-# INLINE toEncodingList #-}
1648 {-# INLINE toEncodingList #-}
1606−instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
1607 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1651 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1608 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1652 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
@@ -1752,13 +1796,11 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
1752 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1796 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1753 {-# INLINE liftToJSON #-}
1797 {-# INLINE liftToJSON #-}
1755− -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
1756 liftToEncoding g _ = case toJSONKey of
1799 liftToEncoding g _ = case toJSONKey of
1757 ToJSONKeyText _ f -> dict f g M.foldrWithKey
1800 ToJSONKeyText _ f -> dict f g M.foldrWithKey
1758 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1801 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1760− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
1761− pairEncoding f (a, b) = tuple $ f a >*< g b
1762 {-# INLINE liftToEncoding #-}
1804 {-# INLINE liftToEncoding #-}
@@ -1796,6 +1838,17 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
1796 toEncoding = toEncoding1
1838 toEncoding = toEncoding1
1797 {-# INLINE toEncoding #-}
1839 {-# INLINE toEncoding #-}
1841+-------------------------------------------------------------------------------
1843+-------------------------------------------------------------------------------
1845+instance ToJSON UUID.UUID where
1846+ toJSON = toJSON . UUID.toText
1847+ toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1849+instance ToJSONKey UUID.UUID where
1850+ toJSONKey = ToJSONKeyText UUID.toText $
1851+ E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1800-------------------------------------------------------------------------------
1853-------------------------------------------------------------------------------
1801-- vector
1854-- vector
@@ -1809,10 +1862,12 @@ instance ToJSON1 Vector where
1809 {-# INLINE liftToEncoding #-}
1862 {-# INLINE liftToEncoding #-}
1811instance (ToJSON a) => ToJSON (Vector a) where
1864instance (ToJSON a) => ToJSON (Vector a) where
1812− toJSON = Array . V.map toJSON
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1813 {-# INLINE toJSON #-}
1868 {-# INLINE toJSON #-}
1815− toEncoding = encodeVector
1870+ toEncoding = toEncoding1
1816 {-# INLINE toEncoding #-}
1871 {-# INLINE toEncoding #-}
1818encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1873encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
@@ -1876,11 +1931,12 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1876 ToJSONKeyText _ f -> dict f g H.foldrWithKey
1931 ToJSONKeyText _ f -> dict f g H.foldrWithKey
1877 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1932 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1879− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
1880− pairEncoding f (a, b) = tuple $ f a >*< g b
1881 {-# INLINE liftToEncoding #-}
1935 {-# INLINE liftToEncoding #-}
1883instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1937instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938+ {-# SPECIALIZE instance ToJSON Object #-}
1884 toJSON = toJSON1
1940 toJSON = toJSON1
1885 {-# INLINE toJSON #-}
1941 {-# INLINE toJSON #-}
@@ -1910,6 +1966,32 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1910formatMillis :: (FormatTime t) => t -> String
1966formatMillis :: (FormatTime t) => t -> String
1911formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1967formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1969+-------------------------------------------------------------------------------
1971+-------------------------------------------------------------------------------
1973+instance ToJSON a => ToJSON (PM.Array a) where
1974+ -- note: we could do better than this if vector exposed the data
1975+ -- constructor in Data.Vector.
1976+ toJSON = toJSON . Exts.toList
1977+ toEncoding = toEncoding . Exts.toList
1979+instance ToJSON a => ToJSON (PM.SmallArray a) where
1980+ toJSON = toJSON . Exts.toList
1981+ toEncoding = toEncoding . Exts.toList
1983+#if (MIN_VERSION_primitive(0,6,4))
1984+instance (PM.Prim a,ToJSON a) => ToJSON (PM.PrimArray a) where
1985+ toJSON = toJSON . Exts.toList
1986+ toEncoding = toEncoding . Exts.toList
1988+#if !MIN_VERSION_primitive(0,7,0)
1989+instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where
1990+ toJSON = toJSON . Exts.toList
1991+ toEncoding = toEncoding . Exts.toList
1913-------------------------------------------------------------------------------
1995-------------------------------------------------------------------------------
1915-------------------------------------------------------------------------------
1997-------------------------------------------------------------------------------
@@ -1958,10 +2040,11 @@ stringEncoding :: Encoding' Text -> Value
1958stringEncoding = String
2040stringEncoding = String
1959 . T.dropAround (== '"')
2041 . T.dropAround (== '"')
1960 . T.decodeLatin1
2042 . T.decodeLatin1
1961− . lazyToStrictByteString
2043+ . L.toStrict
1962 . E.encodingToLazyByteString
2044 . E.encodingToLazyByteString
1963{-# INLINE stringEncoding #-}
2045{-# INLINE stringEncoding #-}
1965instance ToJSON NominalDiffTime where
2048instance ToJSON NominalDiffTime where
1966 toJSON = Number . realToFrac
2049 toJSON = Number . realToFrac
1967 {-# INLINE toJSON #-}
2050 {-# INLINE toJSON #-}
@@ -1969,18 +2052,70 @@ instance ToJSON NominalDiffTime where
1969 toEncoding = E.scientific . realToFrac
2052 toEncoding = E.scientific . realToFrac
1970 {-# INLINE toEncoding #-}
2053 {-# INLINE toEncoding #-}
2056+instance ToJSON DiffTime where
2057+ toJSON = Number . realToFrac
2058+ {-# INLINE toJSON #-}
2060+ toEncoding = E.scientific . realToFrac
2061+ {-# INLINE toEncoding #-}
2063+-- | Encoded as number
2064+instance ToJSON SystemTime where
2065+ toJSON (MkSystemTime secs nsecs) =
2066+ toJSON (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2067+ toEncoding (MkSystemTime secs nsecs) =
2068+ toEncoding (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2070+instance ToJSON CalendarDiffTime where
2071+ toJSON (CalendarDiffTime m nt) = object
2075+ toEncoding (CalendarDiffTime m nt) = E.pairs
2076+ ("months" .= m <> "time" .= nt)
2078+instance ToJSON CalendarDiffDays where
2079+ toJSON (CalendarDiffDays m d) = object
2083+ toEncoding (CalendarDiffDays m d) = E.pairs
2084+ ("months" .= m <> "days" .= d)
2086+instance ToJSON DayOfWeek where
2087+ toJSON Monday = "monday"
2088+ toJSON Tuesday = "tuesday"
2089+ toJSON Wednesday = "wednesday"
2090+ toJSON Thursday = "thursday"
2091+ toJSON Friday = "friday"
2092+ toJSON Saturday = "saturday"
2093+ toJSON Sunday = "sunday"
2095+toEncodingDayOfWeek :: DayOfWeek -> E.Encoding' Text
2096+toEncodingDayOfWeek Monday = E.unsafeToEncoding "\"monday\""
2097+toEncodingDayOfWeek Tuesday = E.unsafeToEncoding "\"tuesday\""
2098+toEncodingDayOfWeek Wednesday = E.unsafeToEncoding "\"wednesday\""
2099+toEncodingDayOfWeek Thursday = E.unsafeToEncoding "\"thursday\""
2100+toEncodingDayOfWeek Friday = E.unsafeToEncoding "\"friday\""
2101+toEncodingDayOfWeek Saturday = E.unsafeToEncoding "\"saturday\""
2102+toEncodingDayOfWeek Sunday = E.unsafeToEncoding "\"sunday\""
2104+instance ToJSONKey DayOfWeek where
2105+ toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek
1972-------------------------------------------------------------------------------
2107-------------------------------------------------------------------------------
1973-- base Monoid/Semigroup
2108-- base Monoid/Semigroup
1974-------------------------------------------------------------------------------
2109-------------------------------------------------------------------------------
1976−instance ToJSON1 Dual where
2111+instance ToJSON1 Monoid.Dual where
1977− liftToJSON t _ = t . getDual
2112+ liftToJSON t _ = t . Monoid.getDual
1978 {-# INLINE liftToJSON #-}
2113 {-# INLINE liftToJSON #-}
1980− liftToEncoding t _ = t . getDual
2115+ liftToEncoding t _ = t . Monoid.getDual
1981 {-# INLINE liftToEncoding #-}
2116 {-# INLINE liftToEncoding #-}
1983−instance ToJSON a => ToJSON (Dual a) where
2118+instance ToJSON a => ToJSON (Monoid.Dual a) where
1984 toJSON = toJSON1
2119 toJSON = toJSON1
1985 {-# INLINE toJSON #-}
2120 {-# INLINE toJSON #-}
@@ -1988,14 +2123,14 @@ instance ToJSON a => ToJSON (Dual a) where
1988 {-# INLINE toEncoding #-}
2123 {-# INLINE toEncoding #-}
1991−instance ToJSON1 First where
2126+instance ToJSON1 Monoid.First where
1992− liftToJSON t to' = liftToJSON t to' . getFirst
2127+ liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
1993 {-# INLINE liftToJSON #-}
2128 {-# INLINE liftToJSON #-}
1995− liftToEncoding t to' = liftToEncoding t to' . getFirst
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
1996 {-# INLINE liftToEncoding #-}
2131 {-# INLINE liftToEncoding #-}
1998−instance ToJSON a => ToJSON (First a) where
2133+instance ToJSON a => ToJSON (Monoid.First a) where
1999 toJSON = toJSON1
2134 toJSON = toJSON1
2000 {-# INLINE toJSON #-}
2135 {-# INLINE toJSON #-}
@@ -2003,14 +2138,103 @@ instance ToJSON a => ToJSON (First a) where
2003 {-# INLINE toEncoding #-}
2138 {-# INLINE toEncoding #-}
2006−instance ToJSON1 Last where
2141+instance ToJSON1 Monoid.Last where
2007− liftToJSON t to' = liftToJSON t to' . getLast
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2008 {-# INLINE liftToJSON #-}
2143 {-# INLINE liftToJSON #-}
2010− liftToEncoding t to' = liftToEncoding t to' . getLast
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2011 {-# INLINE liftToEncoding #-}
2146 {-# INLINE liftToEncoding #-}
2013−instance ToJSON a => ToJSON (Last a) where
2148+instance ToJSON a => ToJSON (Monoid.Last a) where
2150+ {-# INLINE toJSON #-}
2152+ toEncoding = toEncoding1
2153+ {-# INLINE toEncoding #-}
2156+instance ToJSON1 Semigroup.Min where
2157+ liftToJSON t _ (Semigroup.Min x) = t x
2158+ {-# INLINE liftToJSON #-}
2160+ liftToEncoding t _ (Semigroup.Min x) = t x
2161+ {-# INLINE liftToEncoding #-}
2163+instance ToJSON a => ToJSON (Semigroup.Min a) where
2165+ {-# INLINE toJSON #-}
2167+ toEncoding = toEncoding1
2168+ {-# INLINE toEncoding #-}
2171+instance ToJSON1 Semigroup.Max where
2172+ liftToJSON t _ (Semigroup.Max x) = t x
2173+ {-# INLINE liftToJSON #-}
2175+ liftToEncoding t _ (Semigroup.Max x) = t x
2176+ {-# INLINE liftToEncoding #-}
2178+instance ToJSON a => ToJSON (Semigroup.Max a) where
2180+ {-# INLINE toJSON #-}
2182+ toEncoding = toEncoding1
2183+ {-# INLINE toEncoding #-}
2185+instance ToJSON1 Semigroup.First where
2186+ liftToJSON t _ (Semigroup.First x) = t x
2187+ {-# INLINE liftToJSON #-}
2189+ liftToEncoding t _ (Semigroup.First x) = t x
2190+ {-# INLINE liftToEncoding #-}
2192+instance ToJSON a => ToJSON (Semigroup.First a) where
2194+ {-# INLINE toJSON #-}
2196+ toEncoding = toEncoding1
2197+ {-# INLINE toEncoding #-}
2200+instance ToJSON1 Semigroup.Last where
2201+ liftToJSON t _ (Semigroup.Last x) = t x
2202+ {-# INLINE liftToJSON #-}
2204+ liftToEncoding t _ (Semigroup.Last x) = t x
2205+ {-# INLINE liftToEncoding #-}
2207+instance ToJSON a => ToJSON (Semigroup.Last a) where
2209+ {-# INLINE toJSON #-}
2211+ toEncoding = toEncoding1
2212+ {-# INLINE toEncoding #-}
2215+instance ToJSON1 Semigroup.WrappedMonoid where
2216+ liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217+ {-# INLINE liftToJSON #-}
2219+ liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220+ {-# INLINE liftToEncoding #-}
2222+instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2224+ {-# INLINE toJSON #-}
2226+ toEncoding = toEncoding1
2227+ {-# INLINE toEncoding #-}
2230+instance ToJSON1 Semigroup.Option where
2231+ liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232+ {-# INLINE liftToJSON #-}
2234+ liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235+ {-# INLINE liftToEncoding #-}
2237+instance ToJSON a => ToJSON (Semigroup.Option a) where
2014 toJSON = toJSON1
2238 toJSON = toJSON1
2015 {-# INLINE toJSON #-}
2239 {-# INLINE toJSON #-}
@@ -2021,6 +2245,13 @@ instance ToJSON a => ToJSON (Last a) where
2021-- tagged
2245-- tagged
2022-------------------------------------------------------------------------------
2246-------------------------------------------------------------------------------
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
2024instance ToJSON (Proxy a) where
2255instance ToJSON (Proxy a) where
2025 toJSON _ = Null
2256 toJSON _ = Null
2026 {-# INLINE toJSON #-}
2257 {-# INLINE toJSON #-}
@@ -2029,6 +2260,13 @@ instance ToJSON (Proxy a) where
2029 {-# INLINE toEncoding #-}
2260 {-# INLINE toEncoding #-}
2263+instance ToJSON2 Tagged where
2264+ liftToJSON2 _ _ t _ (Tagged x) = t x
2265+ {-# INLINE liftToJSON2 #-}
2267+ liftToEncoding2 _ _ t _ (Tagged x) = t x
2268+ {-# INLINE liftToEncoding2 #-}
2032instance ToJSON1 (Tagged a) where
2270instance ToJSON1 (Tagged a) where
2033 liftToJSON t _ (Tagged x) = t x
2271 liftToJSON t _ (Tagged x) = t x
2034 {-# INLINE liftToJSON #-}
2272 {-# INLINE liftToJSON #-}
@@ -2043,7 +2281,6 @@ instance ToJSON b => ToJSON (Tagged a b) where
2043 toEncoding = toEncoding1
2281 toEncoding = toEncoding1
2044 {-# INLINE toEncoding #-}
2282 {-# INLINE toEncoding #-}
2047instance ToJSONKey b => ToJSONKey (Tagged a b) where
2284instance ToJSONKey b => ToJSONKey (Tagged a b) where
2048 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2049 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2064,7 +2301,7 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2064 toJSONKey = toJSONKeyList
2301 toJSONKey = toJSONKeyList
2066-------------------------------------------------------------------------------
2303-------------------------------------------------------------------------------
2067−-- Tuple instances, see tuple-instances-to.hs
2304+-- Tuple instances
2068-------------------------------------------------------------------------------
2305-------------------------------------------------------------------------------
2070instance ToJSON2 (,) where
2307instance ToJSON2 (,) where
@@ -2075,9 +2312,7 @@ instance ToJSON2 (,) where
2075 return mv
2312 return mv
2076 {-# INLINE liftToJSON2 #-}
2313 {-# INLINE liftToJSON2 #-}
2078− liftToEncoding2 toA _ toB _ (a, b) = tuple $
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2081 {-# INLINE liftToEncoding2 #-}
2316 {-# INLINE liftToEncoding2 #-}
2083instance (ToJSON a) => ToJSON1 ((,) a) where
2318instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2101,10 +2336,11 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
2101 return mv
2336 return mv
2102 {-# INLINE liftToJSON2 #-}
2337 {-# INLINE liftToJSON2 #-}
2104− liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2105− toEncoding a >*<
2340+ [ toEncoding a
2106− toB b >*<
2341+ , toB b
2108 {-# INLINE liftToEncoding2 #-}
2344 {-# INLINE liftToEncoding2 #-}
2110instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
2346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2129,11 +2365,12 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
2129 return mv
2365 return mv
2130 {-# INLINE liftToJSON2 #-}
2366 {-# INLINE liftToJSON2 #-}
2132− liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2133− toEncoding a >*<
2369+ [ toEncoding a
2134− toEncoding b >*<
2370+ , toEncoding b
2135− toC c >*<
2371+ , toC c
2137 {-# INLINE liftToEncoding2 #-}
2374 {-# INLINE liftToEncoding2 #-}
2139instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
2376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2159,12 +2396,13 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
2159 return mv
2396 return mv
2160 {-# INLINE liftToJSON2 #-}
2397 {-# INLINE liftToJSON2 #-}
2162− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2163− toEncoding a >*<
2400+ [ toEncoding a
2164− toEncoding b >*<
2401+ , toEncoding b
2165− toEncoding c >*<
2402+ , toEncoding c
2166− toD d >*<
2403+ , toD d
2168 {-# INLINE liftToEncoding2 #-}
2406 {-# INLINE liftToEncoding2 #-}
2170instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
2408instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2191,13 +2429,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
2191 return mv
2429 return mv
2192 {-# INLINE liftToJSON2 #-}
2430 {-# INLINE liftToJSON2 #-}
2194− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2195− toEncoding a >*<
2433+ [ toEncoding a
2196− toEncoding b >*<
2434+ , toEncoding b
2197− toEncoding c >*<
2435+ , toEncoding c
2198− toEncoding d >*<
2436+ , toEncoding d
2199− toE e >*<
2437+ , toE e
2201 {-# INLINE liftToEncoding2 #-}
2440 {-# INLINE liftToEncoding2 #-}
2203instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
2442instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2225,14 +2464,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
2225 return mv
2464 return mv
2226 {-# INLINE liftToJSON2 #-}
2465 {-# INLINE liftToJSON2 #-}
2228− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2467+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2229− toEncoding a >*<
2468+ [ toEncoding a
2230− toEncoding b >*<
2469+ , toEncoding b
2231− toEncoding c >*<
2470+ , toEncoding c
2232− toEncoding d >*<
2471+ , toEncoding d
2233− toEncoding e >*<
2472+ , toEncoding e
2234− toF f >*<
2473+ , toF f
2236 {-# INLINE liftToEncoding2 #-}
2476 {-# INLINE liftToEncoding2 #-}
2238instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
2478instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2261,15 +2501,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
2261 return mv
2501 return mv
2262 {-# INLINE liftToJSON2 #-}
2502 {-# INLINE liftToJSON2 #-}
2264− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2504+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2265− toEncoding a >*<
2505+ [ toEncoding a
2266− toEncoding b >*<
2506+ , toEncoding b
2267− toEncoding c >*<
2507+ , toEncoding c
2268− toEncoding d >*<
2508+ , toEncoding d
2269− toEncoding e >*<
2509+ , toEncoding e
2270− toEncoding f >*<
2510+ , toEncoding f
2271− toG g >*<
2511+ , toG g
2273 {-# INLINE liftToEncoding2 #-}
2514 {-# INLINE liftToEncoding2 #-}
2275instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
2516instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -2299,16 +2540,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
2299 return mv
2540 return mv
2300 {-# INLINE liftToJSON2 #-}
2541 {-# INLINE liftToJSON2 #-}
2302− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2543+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2303− toEncoding a >*<
2544+ [ toEncoding a
2304− toEncoding b >*<
2545+ , toEncoding b
2305− toEncoding c >*<
2546+ , toEncoding c
2306− toEncoding d >*<
2547+ , toEncoding d
2307− toEncoding e >*<
2548+ , toEncoding e
2308− toEncoding f >*<
2549+ , toEncoding f
2309− toEncoding g >*<
2550+ , toEncoding g
2310− toH h >*<
2551+ , toH h
2312 {-# INLINE liftToEncoding2 #-}
2554 {-# INLINE liftToEncoding2 #-}
2314instance (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
2556instance (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
@@ -2339,17 +2581,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2339 return mv
2581 return mv
2340 {-# INLINE liftToJSON2 #-}
2582 {-# INLINE liftToJSON2 #-}
2342− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2584+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2343− toEncoding a >*<
2585+ [ toEncoding a
2344− toEncoding b >*<
2586+ , toEncoding b
2345− toEncoding c >*<
2587+ , toEncoding c
2346− toEncoding d >*<
2588+ , toEncoding d
2347− toEncoding e >*<
2589+ , toEncoding e
2348− toEncoding f >*<
2590+ , toEncoding f
2349− toEncoding g >*<
2591+ , toEncoding g
2350− toEncoding h >*<
2592+ , toEncoding h
2351− toI i >*<
2593+ , toI i
2353 {-# INLINE liftToEncoding2 #-}
2596 {-# INLINE liftToEncoding2 #-}
2355instance (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
2598instance (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
@@ -2381,18 +2624,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2381 return mv
2624 return mv
2382 {-# INLINE liftToJSON2 #-}
2625 {-# INLINE liftToJSON2 #-}
2384− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2627+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2385− toEncoding a >*<
2628+ [ toEncoding a
2386− toEncoding b >*<
2629+ , toEncoding b
2387− toEncoding c >*<
2630+ , toEncoding c
2388− toEncoding d >*<
2631+ , toEncoding d
2389− toEncoding e >*<
2632+ , toEncoding e
2390− toEncoding f >*<
2633+ , toEncoding f
2391− toEncoding g >*<
2634+ , toEncoding g
2392− toEncoding h >*<
2635+ , toEncoding h
2393− toEncoding i >*<
2636+ , toEncoding i
2394− toJ j >*<
2637+ , toJ j
2396 {-# INLINE liftToEncoding2 #-}
2640 {-# INLINE liftToEncoding2 #-}
2398instance (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
2642instance (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
@@ -2425,19 +2669,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2425 return mv
2669 return mv
2426 {-# INLINE liftToJSON2 #-}
2670 {-# INLINE liftToJSON2 #-}
2428− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2672+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2429− toEncoding a >*<
2673+ [ toEncoding a
2430− toEncoding b >*<
2674+ , toEncoding b
2431− toEncoding c >*<
2675+ , toEncoding c
2432− toEncoding d >*<
2676+ , toEncoding d
2433− toEncoding e >*<
2677+ , toEncoding e
2434− toEncoding f >*<
2678+ , toEncoding f
2435− toEncoding g >*<
2679+ , toEncoding g
2436− toEncoding h >*<
2680+ , toEncoding h
2437− toEncoding i >*<
2681+ , toEncoding i
2438− toEncoding j >*<
2682+ , toEncoding j
2439− toK k >*<
2683+ , toK k
2441 {-# INLINE liftToEncoding2 #-}
2686 {-# INLINE liftToEncoding2 #-}
2443instance (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
2688instance (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
@@ -2471,20 +2716,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2471 return mv
2716 return mv
2472 {-# INLINE liftToJSON2 #-}
2717 {-# INLINE liftToJSON2 #-}
2474− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2475− toEncoding a >*<
2720+ [ toEncoding a
2476− toEncoding b >*<
2721+ , toEncoding b
2477− toEncoding c >*<
2722+ , toEncoding c
2478− toEncoding d >*<
2723+ , toEncoding d
2479− toEncoding e >*<
2724+ , toEncoding e
2480− toEncoding f >*<
2725+ , toEncoding f
2481− toEncoding g >*<
2726+ , toEncoding g
2482− toEncoding h >*<
2727+ , toEncoding h
2483− toEncoding i >*<
2728+ , toEncoding i
2484− toEncoding j >*<
2729+ , toEncoding j
2485− toEncoding k >*<
2730+ , toEncoding k
2486− toL l >*<
2731+ , toL l
2488 {-# INLINE liftToEncoding2 #-}
2734 {-# INLINE liftToEncoding2 #-}
2490instance (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
2736instance (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
@@ -2519,21 +2765,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2519 return mv
2765 return mv
2520 {-# INLINE liftToJSON2 #-}
2766 {-# INLINE liftToJSON2 #-}
2522− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2768+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2523− toEncoding a >*<
2769+ [ toEncoding a
2524− toEncoding b >*<
2770+ , toEncoding b
2525− toEncoding c >*<
2771+ , toEncoding c
2526− toEncoding d >*<
2772+ , toEncoding d
2527− toEncoding e >*<
2773+ , toEncoding e
2528− toEncoding f >*<
2774+ , toEncoding f
2529− toEncoding g >*<
2775+ , toEncoding g
2530− toEncoding h >*<
2776+ , toEncoding h
2531− toEncoding i >*<
2777+ , toEncoding i
2532− toEncoding j >*<
2778+ , toEncoding j
2533− toEncoding k >*<
2779+ , toEncoding k
2534− toEncoding l >*<
2780+ , toEncoding l
2535− toM m >*<
2781+ , toM m
2537 {-# INLINE liftToEncoding2 #-}
2784 {-# INLINE liftToEncoding2 #-}
2539instance (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
2786instance (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
@@ -2569,22 +2816,23 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2569 return mv
2816 return mv
2570 {-# INLINE liftToJSON2 #-}
2817 {-# INLINE liftToJSON2 #-}
2572− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2819+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2573− toEncoding a >*<
2820+ [ toEncoding a
2574− toEncoding b >*<
2821+ , toEncoding b
2575− toEncoding c >*<
2822+ , toEncoding c
2576− toEncoding d >*<
2823+ , toEncoding d
2577− toEncoding e >*<
2824+ , toEncoding e
2578− toEncoding f >*<
2825+ , toEncoding f
2579− toEncoding g >*<
2826+ , toEncoding g
2580− toEncoding h >*<
2827+ , toEncoding h
2581− toEncoding i >*<
2828+ , toEncoding i
2582− toEncoding j >*<
2829+ , toEncoding j
2583− toEncoding k >*<
2830+ , toEncoding k
2584− toEncoding l >*<
2831+ , toEncoding l
2585− toEncoding m >*<
2832+ , toEncoding m
2586− toN n >*<
2833+ , toN n
2588 {-# INLINE liftToEncoding2 #-}
2836 {-# INLINE liftToEncoding2 #-}
2590instance (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
2838instance (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
@@ -2599,27 +2847,26 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2599 toEncoding = toEncoding2
2847 toEncoding = toEncoding2
2600 {-# INLINE toEncoding #-}
2848 {-# INLINE toEncoding #-}
2602−-------------------------------------------------------------------------------
2850+--------------------------------------------------------------------------------
2603−-- pre-bytestring-0.10 compatibility
2604−-------------------------------------------------------------------------------
2606−{-# INLINE lazyToStrictByteString #-}
2852+-- | Wrap a list of pairs as an object.
2607−lazyToStrictByteString :: L.ByteString -> S.ByteString
2853+class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2608−#if MIN_VERSION_bytestring(0,10,0)
2854+ fromPairs :: pairs -> enc
2609−lazyToStrictByteString = L.toStrict
2611−lazyToStrictByteString = packChunks
2613−-- packChunks is taken from the blaze-builder package.
2856+instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857+ fromPairs = E.pairs
2615−-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
2859+instance FromPairs Value (DList Pair) where
2616−packChunks :: L.ByteString -> S.ByteString
2860+ fromPairs = object . toList
2617−packChunks lbs = do
2861+
2618− S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
2862+-- | Like 'KeyValue' but the value is already converted to JSON
2619− where
2863+-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2620− copyChunks !L.Empty !_pf = return ()
2864+-- so it can be readily concatenated.
2621− copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
2865+class Monoid kv => KeyValuePair v kv where
2622− withForeignPtr fpbuf $ \pbuf ->
2866+ pair :: String -> v -> kv
2623− copyBytes pf (pbuf `plusPtr` o) l
2867+
2624− copyChunks lbs' (pf `plusPtr` l)
2868+instance (v ~ Value) => KeyValuePair v (DList Pair) where
2625−#endif
2869+ pair k v = DList.singleton (pack k .= v)
2871+instance (e ~ Encoding) => KeyValuePair e Series where