@@ -1,25 +1,21 @@
1−{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE EmptyDataDecls #-}
5{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE GADTs #-}
7{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
9−{-# LANGUAGE NamedFieldPuns #-}
10{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
11{-# LANGUAGE PatternGuards #-}
10{-# 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 #-}
16{-# LANGUAGE UndecidableInstances #-}
15{-# 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 #-}
@@ -37,7 +33,6 @@ module Data.Aeson.Types.ToJSON
37 , toEncoding2
33 , toEncoding2
38 -- * Generic JSON classes
34 -- * Generic JSON classes
39 , GToJSON(..)
35 , GToJSON(..)
41 , ToArgs(..)
36 , ToArgs(..)
42 , genericToJSON
37 , genericToJSON
43 , genericToEncoding
38 , genericToEncoding
@@ -48,55 +43,63 @@ module Data.Aeson.Types.ToJSON
48 , ToJSONKeyFunction(..)
43 , ToJSONKeyFunction(..)
49 , toJSONKeyText
44 , toJSONKeyText
50 , contramapToJSONKeyFunction
45 , contramapToJSONKeyFunction
51 -- * Object key-value pairs
50 -- * Object key-value pairs
52 , KeyValue(..)
51 , KeyValue(..)
53 -- * Functions needed for documentation
54 -- * Functions needed for documentation
54 -- * Encoding functions
55 -- * Encoding functions
55 , listEncoding
56 , listEncoding
56 , listValue
57 , listValue
60import Prelude.Compat
60import Prelude.Compat
62import Control.Applicative (Const(..))
62import Control.Applicative (Const(..))
63import Control.Monad.ST (ST)
63import Control.Monad.ST (ST)
64import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
64import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65−import Data.Aeson.Encoding.Internal ((>*<), (><), tuple)
65+import Data.Aeson.Encoding.Internal ((>*<))
66import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
66import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord(..), One, ProductSize, Tagged2(..), True, Zero, productSize)
67+import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
68import Data.Aeson.Types.Internal
68import Data.Aeson.Types.Internal
69import Data.Attoparsec.Number (Number(..))
69import Data.Attoparsec.Number (Number(..))
70import Data.Bits (unsafeShiftR)
70import Data.Bits (unsafeShiftR)
71import Data.DList (DList)
71import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution)
72+import Data.Fixed (Fixed, HasResolution, Nano)
73import Data.Foldable (toList)
73import Data.Foldable (toList)
74import Data.Functor.Compose (Compose(..))
74import Data.Functor.Compose (Compose(..))
75+import Data.Functor.Contravariant (Contravariant (..))
75import Data.Functor.Identity (Identity(..))
76import Data.Functor.Identity (Identity(..))
76import Data.Functor.Product (Product(..))
77import Data.Functor.Product (Product(..))
77import Data.Functor.Sum (Sum(..))
78import Data.Functor.Sum (Sum(..))
78import Data.Int (Int16, Int32, Int64, Int8)
79import Data.Int (Int16, Int32, Int64, Int8)
79import Data.List (intersperse)
80import Data.List (intersperse)
80import Data.List.NonEmpty (NonEmpty(..))
81import Data.List.NonEmpty (NonEmpty(..))
81−import Data.Monoid ((<>), Dual(..), First(..), Last(..))
82+import Data.Semigroup ((<>))
82import Data.Proxy (Proxy(..))
83import Data.Proxy (Proxy(..))
83import Data.Ratio (Ratio, denominator, numerator)
84import Data.Ratio (Ratio, denominator, numerator)
84import Data.Scientific (Scientific)
85import Data.Scientific (Scientific)
85import Data.Tagged (Tagged(..))
86import Data.Tagged (Tagged(..))
86import Data.Text (Text, pack)
87import Data.Text (Text, pack)
87−import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
88+import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
89+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
90+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
91+import Data.Time.Clock.System.Compat (SystemTime (..))
88−import Data.Time.Format (FormatTime, formatTime)
92+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
89−import Data.Time.Locale.Compat (defaultTimeLocale)
90import Data.Vector (Vector)
93import Data.Vector (Vector)
91import Data.Version (Version, showVersion)
94import Data.Version (Version, showVersion)
95+import Data.Void (Void, absurd)
92import Data.Word (Word16, Word32, Word64, Word8)
96import Data.Word (Word16, Word32, Word64, Word8)
93import Foreign.Storable (Storable)
97import Foreign.Storable (Storable)
98+import Foreign.C.Types (CTime (..))
94import GHC.Generics
99import GHC.Generics
95import Numeric.Natural (Natural)
100import Numeric.Natural (Natural)
96import qualified Data.Aeson.Encoding as E
101import qualified Data.Aeson.Encoding as E
97−-- We need internal here for generic deriving
98−import qualified Data.Aeson.Encoding.Internal as E (InArray, closeCurly, colon, comma, econcat, empty, openCurly, retagEncoding, tuple, wrapObject)
102+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
99−import qualified Data.ByteString as S
100import qualified Data.ByteString.Lazy as L
103import qualified Data.ByteString.Lazy as L
101import qualified Data.DList as DList
104import qualified Data.DList as DList
102import qualified Data.HashMap.Strict as H
105import qualified Data.HashMap.Strict as H
@@ -105,13 +108,16 @@ import qualified Data.IntMap as IntMap
105import qualified Data.IntSet as IntSet
108import qualified Data.IntSet as IntSet
106import qualified Data.List.NonEmpty as NE
109import qualified Data.List.NonEmpty as NE
107import qualified Data.Map as M
110import qualified Data.Map as M
111+import qualified Data.Monoid as Monoid
108import qualified Data.Scientific as Scientific
112import qualified Data.Scientific as Scientific
113+import qualified Data.Semigroup as Semigroup
109import qualified Data.Sequence as Seq
114import qualified Data.Sequence as Seq
110import qualified Data.Set as Set
115import qualified Data.Set as Set
111import qualified Data.Text as T
116import qualified Data.Text as T
112import qualified Data.Text.Encoding as T
117import qualified Data.Text.Encoding as T
113import qualified Data.Text.Lazy as LT
118import qualified Data.Text.Lazy as LT
114import qualified Data.Tree as Tree
119import qualified Data.Tree as Tree
120+import qualified Data.UUID.Types as UUID
115import qualified Data.Vector as V
121import qualified Data.Vector as V
116import qualified Data.Vector.Generic as VG
122import qualified Data.Vector.Generic as VG
117import qualified Data.Vector.Mutable as VM
123import qualified Data.Vector.Mutable as VM
@@ -119,12 +125,19 @@ import qualified Data.Vector.Primitive as VP
119import qualified Data.Vector.Storable as VS
125import qualified Data.Vector.Storable as VS
120import qualified Data.Vector.Unboxed as VU
126import qualified Data.Vector.Unboxed as VU
122−#if !(MIN_VERSION_bytestring(0,10,0))
128+import qualified Data.Aeson.Encoding.Builder as EB
123−import Foreign.ForeignPtr (withForeignPtr)
129+import qualified Data.ByteString.Builder as B
124−import Foreign.Marshal.Utils (copyBytes)
130+
125−import Foreign.Ptr (plusPtr)
131+import qualified GHC.Exts as Exts
126−import qualified Data.ByteString.Internal as S
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
127−import qualified Data.ByteString.Lazy.Internal as L
140+import qualified Data.Primitive.PrimArray as PM
130toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
@@ -143,19 +156,16 @@ realFloatToJSON d
144-- | Class of generic representation types that can be converted to
157-- | Class of generic representation types that can be converted to
146−class GToJSON arity f where
159+class GToJSON enc arity f where
147 -- | This method (applied to 'defaultOptions') is used as the
160 -- | This method (applied to 'defaultOptions') is used as the
148− -- default generic implementation of 'toJSON' (if the @arity@ is 'Zero')
161+ -- default generic implementation of 'toJSON'
162+ -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
149− -- or 'liftToJSON' (if the @arity@ is 'One').
163+ -- and 'liftToJSON' (if the @arity@ is 'One').
150− gToJSON :: Options -> ToArgs Value arity a -> f a -> Value
164+ --
152−-- | Class of generic representation types that can be converted to
153−-- a JSON 'Encoding'.
154−class GToEncoding arity f where
155− -- | This method (applied to 'defaultOptions') can be used as the
156− -- default generic implementation of 'toEncoding' (if the @arity@ is 'Zero')
165+ -- It also provides a generic implementation of 'toEncoding'
166+ -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
157− -- or 'liftToEncoding' (if the @arity@ is 'One').
167+ -- and 'liftToEncoding' (if the @arity@ is 'One').
158− gToEncoding :: Options -> ToArgs Encoding arity a -> f a -> Encoding
168+ gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
160-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
170-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
161-- function arguments that encode occurrences of the type parameter (for
171-- function arguments that encode occurrences of the type parameter (for
@@ -167,14 +177,14 @@ data ToArgs res arity a where
167-- | A configurable generic JSON creator. This function applied to
177-- | A configurable generic JSON creator. This function applied to
168-- 'defaultOptions' is used as the default for 'toJSON' when the type
178-- 'defaultOptions' is used as the default for 'toJSON' when the type
169-- is an instance of 'Generic'.
179-- is an instance of 'Generic'.
170−genericToJSON :: (Generic a, GToJSON Zero (Rep a))
180+genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
171 => Options -> a -> Value
181 => Options -> a -> Value
172genericToJSON opts = gToJSON opts NoToArgs . from
182genericToJSON opts = gToJSON opts NoToArgs . from
174-- | A configurable generic JSON creator. This function applied to
184-- | A configurable generic JSON creator. This function applied to
175-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
185-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
176-- is an instance of 'Generic1'.
186-- is an instance of 'Generic1'.
177−genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
187+genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
178 => Options -> (a -> Value) -> ([a] -> Value)
188 => Options -> (a -> Value) -> ([a] -> Value)
179 -> f a -> Value
189 -> f a -> Value
180genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
190genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
@@ -182,17 +192,17 @@ genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
182-- | A configurable generic JSON encoder. This function applied to
192-- | A configurable generic JSON encoder. This function applied to
183-- 'defaultOptions' is used as the default for 'toEncoding' when the type
193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
184-- is an instance of 'Generic'.
194-- is an instance of 'Generic'.
185−genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
195+genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
186 => Options -> a -> Encoding
196 => Options -> a -> Encoding
187−genericToEncoding opts = gToEncoding opts NoToArgs . from
197+genericToEncoding opts = gToJSON opts NoToArgs . from
189-- | A configurable generic JSON encoder. This function applied to
199-- | A configurable generic JSON encoder. This function applied to
190-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
200-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
191-- is an instance of 'Generic1'.
201-- is an instance of 'Generic1'.
192−genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
202+genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
193 => Options -> (a -> Encoding) -> ([a] -> Encoding)
203 => Options -> (a -> Encoding) -> ([a] -> Encoding)
194 -> f a -> Encoding
204 -> f a -> Encoding
195−genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
197-------------------------------------------------------------------------------
207-------------------------------------------------------------------------------
@@ -200,6 +210,9 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
201-- | 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'.
203-- An example type and instance:
216-- An example type and instance:
@@ -208,10 +221,10 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
209-- data Coord = Coord { x :: Double, y :: Double }
222-- data Coord = Coord { x :: Double, y :: Double }
211−-- instance ToJSON Coord where
224+-- instance 'ToJSON' Coord where
212−-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
214−-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
217-- Instead of manually writing your 'ToJSON' instance, there are two options
230-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -219,17 +232,15 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
220-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
221-- 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
222−-- so will probably be more efficient than the following two options:
235+-- so it will probably be more efficient than the following option.
224-- * The compiler can provide a default generic implementation for
237-- * The compiler can provide a default generic implementation for
225-- 'toJSON'.
238-- 'toJSON'.
227-- 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
228−-- datatype and declare a 'ToJSON' instance for your datatype without giving
241+-- datatype and declare a 'ToJSON' instance. If you require nothing other than
229−-- definitions for 'toJSON' or 'toEncoding'.
242+-- 'defaultOptions', it is sufficient to write (and this is the only
230−--
243+-- alternative where the default 'toJSON' implementation is sufficient):
231−-- For example, the previous example can be simplified to a more
235-- {-\# LANGUAGE DeriveGeneric \#-}
246-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -238,35 +249,46 @@ genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
239-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
241−-- instance ToJSON Coord where
252+-- instance 'ToJSON' Coord where
242−-- toEncoding = 'genericToEncoding' 'defaultOptions'
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
245−-- 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
246−-- 'toEncoding' function is a relatively new addition to this class.
257+-- to implement both methods:
247−-- To allow users of older versions of this library to upgrade without
248−-- having to edit all of their instances or encounter surprising
249−-- incompatibilities, the default implementation of 'toEncoding' uses
250−-- 'toJSON'. This produces correct results, but since it performs an
251−-- intermediate conversion to a 'Value', it will be less efficient
252−-- than directly emitting an 'Encoding'. Our one-liner definition of
253−-- 'toEncoding' above bypasses the intermediate 'Value'.
255−-- If @DefaultSignatures@ doesn't give exactly the results you want,
256−-- you can customize the generic encoding with only a tiny amount of
257−-- effort, using 'genericToJSON' and 'genericToEncoding' with your
258−-- preferred 'Options':
260+-- customOptions = 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
261−-- instance ToJSON Coord where
264+-- instance 'ToJSON' Coord where
262−-- toJSON = 'genericToJSON' 'defaultOptions'
265+-- 'toJSON' = 'genericToJSON' customOptions
263−-- toEncoding = 'genericToEncoding' 'defaultOptions'
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.)
265class ToJSON a where
287class ToJSON a where
266 -- | Convert a Haskell value to a JSON-friendly intermediate type.
288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
267 toJSON :: a -> Value
289 toJSON :: a -> Value
269− default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
270 toJSON = genericToJSON defaultOptions
292 toJSON = genericToJSON defaultOptions
272 -- | Encode a Haskell value as JSON.
294 -- | Encode a Haskell value as JSON.
@@ -283,8 +305,8 @@ class ToJSON a where
283 -- extension, and then have GHC generate a method body as follows.
305 -- extension, and then have GHC generate a method body as follows.
286− -- instance ToJSON Coord where
308+ -- instance 'ToJSON' Coord where
287− -- toEncoding = 'genericToEncoding' 'defaultOptions'
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
290 toEncoding :: a -> Encoding
312 toEncoding :: a -> Encoding
@@ -316,6 +338,13 @@ instance KeyValue Pair where
316 name .= value = (name, toJSON value)
338 name .= value = (name, toJSON value)
317 {-# 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)
319-------------------------------------------------------------------------------
348-------------------------------------------------------------------------------
320-- Classes and types for map keys
349-- Classes and types for map keys
321-------------------------------------------------------------------------------
350-------------------------------------------------------------------------------
@@ -373,7 +402,7 @@ instance KeyValue Pair where
373-- newtype wrapper around 'Text'. The recommended approach is to use
402-- newtype wrapper around 'Text'. The recommended approach is to use
374-- generalized newtype deriving:
403-- generalized newtype deriving:
376−-- > newtype RecordId = RecordId { getRecordId :: Text}
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
377-- > deriving (Eq,Ord,ToJSONKey)
406-- > deriving (Eq,Ord,ToJSONKey)
379-- Then we may write:
408-- Then we may write:
@@ -388,8 +417,18 @@ instance KeyValue Pair where
389-- 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
390-- 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
391−-- and from 'Text' that does not require any escape sequences. So, in
420+-- and from 'Text' that does not require any escape sequences. So
392−-- 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__
393-- The 'Show' instance can be used to help write 'ToJSONKey':
432-- The 'Show' instance can be used to help write 'ToJSONKey':
395-- > instance ToJSONKey Color where
434-- > instance ToJSONKey Color where
@@ -464,16 +503,42 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
464 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
465 tot = T.dropAround (== '"')
504 tot = T.dropAround (== '"')
466 . T.decodeLatin1
505 . T.decodeLatin1
467− . lazyToStrictByteString
506+ . L.toStrict
468 . E.encodingToLazyByteString
507 . E.encodingToLazyByteString
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
471-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
513-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
472contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
473contramapToJSONKeyFunction h x = case x of
515contramapToJSONKeyFunction h x = case x of
474 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
516 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
475 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
477-------------------------------------------------------------------------------
542-------------------------------------------------------------------------------
478-- Lifings of FromJSON and ToJSON to unary and binary type constructors
543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
479-------------------------------------------------------------------------------
544-------------------------------------------------------------------------------
@@ -486,7 +551,7 @@ contramapToJSONKeyFunction h x = case x of
487-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
552-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
488-- 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
489−-- so will probably be more efficient than the following two options:
554+-- so it will probably be more efficient than the following option.
491-- * The compiler can provide a default generic implementation for
556-- * The compiler can provide a default generic implementation for
492-- 'toJSON1'.
557-- 'toJSON1'.
@@ -504,23 +569,29 @@ contramapToJSONKeyFunction h x = case x of
505-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
570-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
507−-- instance ToJSON a => ToJSON1 (Pair a)
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
510−-- If @DefaultSignatures@ doesn't give exactly the results you want,
575+-- If the default implementation doesn't give exactly the results you want,
511-- 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
512-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
577-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
513-- your preferred 'Options':
578-- your preferred 'Options':
581+-- customOptions = 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
516−-- instance ToJSON a => ToJSON1 (Pair a) where
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
517−-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
518−-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
590+-- See also 'ToJSON'.
520class ToJSON1 f where
591class ToJSON1 f where
521 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
523− default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
524 => (a -> Value) -> ([a] -> Value) -> f a -> Value
595 => (a -> Value) -> ([a] -> Value) -> f a -> Value
525 liftToJSON = genericLiftToJSON defaultOptions
596 liftToJSON = genericLiftToJSON defaultOptions
@@ -529,7 +600,7 @@ class ToJSON1 f where
530 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
532− default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
533 => (a -> Encoding) -> ([a] -> Encoding)
604 => (a -> Encoding) -> ([a] -> Encoding)
534 -> f a -> Encoding
605 -> f a -> Encoding
535 liftToEncoding = genericLiftToEncoding defaultOptions
606 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -583,7 +654,7 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
584-- newtype F a = F [a]
655-- newtype F a = F [a]
586−-- -- This instance encodes String as an array of chars
657+-- -- This instance encodes 'String' as an array of chars
587-- instance 'ToJSON1' F where
658-- instance 'ToJSON1' F where
588-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
659-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
589-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
660-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
@@ -614,6 +685,11 @@ instance ToJSON1 [] where
614 {-# INLINE liftToEncoding #-}
685 {-# INLINE liftToEncoding #-}
616instance (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] #-}
617 toJSON = toJSON1
693 toJSON = toJSON1
618 {-# INLINE toJSON #-}
694 {-# INLINE toJSON #-}
@@ -624,39 +700,80 @@ instance (ToJSON a) => ToJSON [a] where
624-- Generic toJSON / toEncoding
700-- Generic toJSON / toEncoding
625-------------------------------------------------------------------------------
701-------------------------------------------------------------------------------
627−--------------------------------------------------------------------------------
630−instance OVERLAPPABLE_ (GToJSON arity a) => GToJSON arity (M1 i c a) where
703+instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
631 -- Meta-information, which is not handled elsewhere, is ignored:
704 -- Meta-information, which is not handled elsewhere, is ignored:
632 gToJSON opts targs = gToJSON opts targs . unM1
705 gToJSON opts targs = gToJSON opts targs . unM1
706+ {-# INLINE gToJSON #-}
634−instance (ToJSON a) => GToJSON arity (K1 i a) where
708+instance GToJSON enc One Par1 where
635− -- Constant values are encoded using their ToJSON instance:
636− gToJSON _opts _ = toJSON . unK1
638−instance GToJSON One Par1 where
639 -- Direct occurrences of the last type parameter are encoded with the
709 -- Direct occurrences of the last type parameter are encoded with the
640 -- function passed in as an argument:
710 -- function passed in as an argument:
641 gToJSON _opts (To1Args tj _) = tj . unPar1
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 #-}
744+--------------------------------------------------------------------------------
747+-- Note: Refactoring 'ToJSON a' to 'ToJSON enc a' (and 'ToJSON1' similarly) is
748+-- possible but makes error messages a bit harder to understand for missing
751+instance GToJSON Value arity V1 where
752+ -- Empty values do not exist, which makes the job of formatting them
754+ gToJSON _ _ x = x `seq` error "case: V1"
755+ {-# INLINE gToJSON #-}
757+instance ToJSON a => GToJSON Value arity (K1 i a) where
758+ -- Constant values are encoded using their ToJSON instance:
759+ gToJSON _opts _ = toJSON . unK1
760+ {-# INLINE gToJSON #-}
643−instance (ToJSON1 f) => GToJSON One (Rec1 f) where
762+instance ToJSON1 f => GToJSON Value One (Rec1 f) where
644 -- Recursive occurrences of the last type parameter are encoded using their
763 -- Recursive occurrences of the last type parameter are encoded using their
645 -- ToJSON1 instance:
764 -- ToJSON1 instance:
646 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
765 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766+ {-# INLINE gToJSON #-}
648−instance GToJSON arity U1 where
768+instance GToJSON Value arity U1 where
649 -- Empty constructors are encoded to an empty array:
769 -- Empty constructors are encoded to an empty array:
650 gToJSON _opts _ _ = emptyArray
770 gToJSON _opts _ _ = emptyArray
651−
771+ {-# INLINE gToJSON #-}
652−instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
653− -- Constructors need to be encoded differently depending on whether they're
654− -- a record or not. This distinction is made by 'consToJSON':
655− gToJSON opts targs = consToJSON opts targs . unM1
657instance ( WriteProduct arity a, WriteProduct arity b
773instance ( WriteProduct arity a, WriteProduct arity b
658 , ProductSize a, ProductSize b
774 , ProductSize a, ProductSize b
659− ) => GToJSON arity (a :*: b) where
775+ ) => GToJSON Value arity (a :*: b)
660 -- 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
661 -- 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
662 -- 'writeProduct':
779 -- 'writeProduct':
@@ -668,238 +785,175 @@ instance ( WriteProduct arity a, WriteProduct arity b
669 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
670 productSize
787 productSize
788+ {-# INLINE gToJSON #-}
672−instance ( AllNullary (a :+: b) allNullary
790+instance ( ToJSON1 f
673− , SumToJSON arity (a :+: b) allNullary
791+ , GToJSON Value One g
674− ) => GToJSON arity (a :+: b) where
792+ ) => GToJSON Value One (f :.: g)
675− -- If all constructors of a sum datatype are nullary and the
793+ where
676− -- 'allNullaryToStringTag' option is set they are encoded to
677− -- strings. This distinction is made by 'sumToJSON':
678− gToJSON opts targs = (unTagged :: Tagged allNullary Value -> Value)
679− . sumToJSON opts targs
681−instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
682 -- 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
683 -- 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
684 -- instance to generically encode the innermost type:
796 -- instance to generically encode the innermost type:
685 gToJSON opts targs =
797 gToJSON opts targs =
686 let gtj = gToJSON opts targs in
798 let gtj = gToJSON opts targs in
687 liftToJSON gtj (listValue gtj) . unComp1
799 liftToJSON gtj (listValue gtj) . unComp1
800+ {-# INLINE gToJSON #-}
689--------------------------------------------------------------------------------
802--------------------------------------------------------------------------------
690-- Generic toEncoding
803-- Generic toEncoding
692−instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
693− -- Meta-information, which is not handled elsewhere, is ignored:
694− gToEncoding opts targs = gToEncoding opts targs . unM1
696−instance (ToJSON a) => GToEncoding arity (K1 i a) where
805+instance ToJSON a => GToJSON Encoding arity (K1 i a) where
697 -- Constant values are encoded using their ToJSON instance:
806 -- Constant values are encoded using their ToJSON instance:
698− gToEncoding _opts _ = toEncoding . unK1
807+ gToJSON _opts _ = toEncoding . unK1
699−
808+ {-# INLINE gToJSON #-}
700−instance GToEncoding One Par1 where
701− -- Direct occurrences of the last type parameter are encoded with the
702− -- function passed in as an argument:
703− gToEncoding _opts (To1Args te _) = te . unPar1
705−instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
810+instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
706 -- Recursive occurrences of the last type parameter are encoded using their
811 -- Recursive occurrences of the last type parameter are encoded using their
707 -- ToEncoding1 instance:
812 -- ToEncoding1 instance:
708− gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1
813+ gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814+ {-# INLINE gToJSON #-}
710−instance GToEncoding arity U1 where
816+instance GToJSON Encoding arity U1 where
711 -- Empty constructors are encoded to an empty array:
817 -- Empty constructors are encoded to an empty array:
712− gToEncoding _opts _ _ = E.emptyArray_
818+ gToJSON _opts _ _ = E.emptyArray_
713−
819+ {-# INLINE gToJSON #-}
714−instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
715− -- Constructors need to be encoded differently depending on whether they're
716− -- a record or not. This distinction is made by 'consToEncoding':
717− gToEncoding opts targs = consToEncoding opts targs . unM1
719instance ( EncodeProduct arity a
821instance ( EncodeProduct arity a
720 , EncodeProduct arity b
822 , EncodeProduct arity b
721− ) => GToEncoding arity (a :*: b) where
823+ ) => GToJSON Encoding arity (a :*: b)
722 -- 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
723 -- 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
724 -- 'encodeProduct':
827 -- 'encodeProduct':
725− gToEncoding opts targs p = E.tuple $ encodeProduct opts targs p
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829+ {-# INLINE gToJSON #-}
727−instance ( AllNullary (a :+: b) allNullary
831+instance ( ToJSON1 f
728− , SumToEncoding arity (a :+: b) allNullary
832+ , GToJSON Encoding One g
729− ) => GToEncoding arity (a :+: b) where
833+ ) => GToJSON Encoding One (f :.: g)
730− -- If all constructors of a sum datatype are nullary and the
834+ where
731− -- 'allNullaryToStringTag' option is set they are encoded to
732− -- strings. This distinction is made by 'sumToEncoding':
733− gToEncoding opts targs
734− = (unTagged :: Tagged allNullary Encoding -> Encoding)
735− . sumToEncoding opts targs
737−instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
738 -- 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
739 -- 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
740 -- instance to generically encode the innermost type:
837 -- instance to generically encode the innermost type:
741− gToEncoding opts targs =
838+ gToJSON opts targs =
742− let gte = gToEncoding opts targs in
839+ let gte = gToJSON opts targs in
743 liftToEncoding gte (listEncoding gte) . unComp1
840 liftToEncoding gte (listEncoding gte) . unComp1
841+ {-# INLINE gToJSON #-}
745--------------------------------------------------------------------------------
843--------------------------------------------------------------------------------
747−class SumToJSON arity f allNullary where
845+class SumToJSON enc arity f allNullary where
748− sumToJSON :: Options -> ToArgs Value arity a
846+ sumToJSON :: Options -> ToArgs enc arity a
749− -> f a -> Tagged allNullary Value
847+ -> f a -> Tagged allNullary enc
751−instance ( GetConName f
849+instance ( GetConName f
752− , TaggedObjectPairs arity f
850+ , FromString enc
753− , ObjectWithSingleFieldObj arity f
851+ , TaggedObject enc arity f
754− , TwoElemArrayObj arity f
852+ , SumToJSON' ObjectWithSingleField enc arity f
755− , UntaggedValueObj arity f
853+ , SumToJSON' TwoElemArray enc arity f
854+ , SumToJSON' UntaggedValue enc arity f
756− ) => SumToJSON arity f True where
855+ ) => SumToJSON enc arity f True
757 sumToJSON opts targs
857 sumToJSON opts targs
758− | allNullaryToStringTag opts = Tagged . String . pack
858+ | allNullaryToStringTag opts = Tagged . fromString
759 . constructorTagModifier opts . getConName
859 . constructorTagModifier opts . getConName
760 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
860 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
762−instance ( TwoElemArrayObj arity f
862+instance ( TaggedObject enc arity f
763− , TaggedObjectPairs arity f
863+ , SumToJSON' ObjectWithSingleField enc arity f
764− , ObjectWithSingleFieldObj arity f
864+ , SumToJSON' TwoElemArray enc arity f
765− , UntaggedValueObj arity f
865+ , SumToJSON' UntaggedValue enc arity f
766− ) => SumToJSON arity f False where
866+ ) => SumToJSON enc arity f False
767 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
868 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
769−nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
870+nonAllNullarySumToJSON :: ( TaggedObject enc arity f
770− , TaggedObjectPairs arity f
871+ , SumToJSON' ObjectWithSingleField enc arity f
771− , ObjectWithSingleFieldObj arity f
872+ , SumToJSON' TwoElemArray enc arity f
772− , UntaggedValueObj arity f
873+ , SumToJSON' UntaggedValue enc arity f
773− ) => Options -> ToArgs Value arity a
874+ ) => Options -> ToArgs enc arity a
774− -> f a -> Value
875+ -> f a -> enc
775nonAllNullarySumToJSON opts targs =
876nonAllNullarySumToJSON opts targs =
776 case sumEncoding opts of
877 case sumEncoding opts of
778− object . taggedObjectPairs opts targs tagFieldName contentsFieldName
779− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs
780− TwoElemArray -> Array . twoElemArrayObj opts targs
781− UntaggedValue -> untaggedValueObj opts targs
783−--------------------------------------------------------------------------------
785−class SumToEncoding arity f allNullary where
786− sumToEncoding :: Options -> ToArgs Encoding arity a
787− -> f a -> Tagged allNullary Encoding
789−instance ( GetConName f
790− , TaggedObjectEnc arity f
791− , ObjectWithSingleFieldEnc arity f
792− , TwoElemArrayEnc arity f
793− , UntaggedValueEnc arity f
794− ) => SumToEncoding arity f True where
795− sumToEncoding opts targs
796− | allNullaryToStringTag opts = Tagged . toEncoding .
797− constructorTagModifier opts . getConName
798− | otherwise = Tagged . nonAllNullarySumToEncoding opts targs
800−instance ( TwoElemArrayEnc arity f
801− , TaggedObjectEnc arity f
802− , ObjectWithSingleFieldEnc arity f
803− , UntaggedValueEnc arity f
804− ) => SumToEncoding arity f False where
805− sumToEncoding opts targs = Tagged . nonAllNullarySumToEncoding opts targs
807−nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
808− , TaggedObjectEnc arity f
809− , ObjectWithSingleFieldEnc arity f
810− , UntaggedValueEnc arity f
811− ) => Options -> ToArgs Encoding arity a
813−nonAllNullarySumToEncoding opts targs =
814− case sumEncoding opts of
815 TaggedObject{..} ->
879 TaggedObject{..} ->
816− taggedObjectEnc opts targs tagFieldName contentsFieldName
880+ taggedObject opts targs tagFieldName contentsFieldName
817− ObjectWithSingleField -> objectWithSingleFieldEnc opts targs
818− TwoElemArray -> twoElemArrayEnc opts targs
819− UntaggedValue -> untaggedValueEnc opts targs
821−--------------------------------------------------------------------------------
882+ ObjectWithSingleField ->
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
823−class TaggedObjectPairs arity f where
886+ TwoElemArray ->
824− taggedObjectPairs :: Options -> ToArgs Value arity a
828−instance ( TaggedObjectPairs arity a
829− , TaggedObjectPairs arity b
830− ) => TaggedObjectPairs arity (a :+: b) where
831− taggedObjectPairs opts targs tagFieldName contentsFieldName (L1 x) =
832− taggedObjectPairs opts targs tagFieldName contentsFieldName x
833− taggedObjectPairs opts targs tagFieldName contentsFieldName (R1 x) =
834− taggedObjectPairs opts targs tagFieldName contentsFieldName x
836−instance ( IsRecord a isRecord
837− , TaggedObjectPairs' arity a isRecord
839− ) => TaggedObjectPairs arity (C1 c a) where
840− taggedObjectPairs opts targs tagFieldName contentsFieldName =
841− (pack tagFieldName .= constructorTagModifier opts
842− (conName (undefined :: t c a p)) :) .
843− (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
844− taggedObjectPairs' opts targs contentsFieldName . unM1
888+ . sumToJSON' opts targs
846−class TaggedObjectPairs' arity f isRecord where
890+ UntaggedValue ->
847− taggedObjectPairs' :: Options -> ToArgs Value arity a
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
848− -> String -> f a -> Tagged isRecord [Pair]
892+ . sumToJSON' opts targs
850−instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
894+--------------------------------------------------------------------------------
851− taggedObjectPairs' _ _ _ _ = Tagged []
853−instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
896+class FromString enc where
854− taggedObjectPairs' opts targs _ =
897+ fromString :: String -> enc
855− Tagged . toList . recordToPairs opts targs
857−instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
899+instance FromString Encoding where
858− taggedObjectPairs' opts targs contentsFieldName =
900+ fromString = toEncoding
859− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs
901+
902+instance FromString Value where
903+ fromString = String . pack
861--------------------------------------------------------------------------------
905--------------------------------------------------------------------------------
863−class TaggedObjectEnc arity f where
907+class TaggedObject enc arity f where
864− taggedObjectEnc :: Options -> ToArgs Encoding arity a
908+ taggedObject :: Options -> ToArgs enc arity a
865− -> String -> String
909+ -> String -> String
866− -> f a -> Encoding
910+ -> f a -> enc
868−instance ( TaggedObjectEnc arity a
912+instance ( TaggedObject enc arity a
869− , TaggedObjectEnc arity b
913+ , TaggedObject enc arity b
870− ) => TaggedObjectEnc arity (a :+: b) where
914+ ) => TaggedObject enc arity (a :+: b)
871− taggedObjectEnc opts targs tagFieldName contentsFieldName (L1 x) =
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
872− taggedObjectEnc opts targs tagFieldName contentsFieldName x
917+ taggedObject opts targs tagFieldName contentsFieldName x
873− taggedObjectEnc opts targs tagFieldName contentsFieldName (R1 x) =
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
874− taggedObjectEnc opts targs tagFieldName contentsFieldName x
919+ taggedObject opts targs tagFieldName contentsFieldName x
876−instance ( IsRecord a isRecord
921+instance ( IsRecord a isRecord
877− , TaggedObjectEnc' arity a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
925+ , KeyValuePair enc pairs
878 , Constructor c
926 , Constructor c
879− ) => TaggedObjectEnc arity (C1 c a) where
927+ ) => TaggedObject enc arity (C1 c a)
880− taggedObjectEnc opts targs tagFieldName contentsFieldName v =
929+ taggedObject opts targs tagFieldName contentsFieldName =
881− E.wrapObject $
930+ fromPairs . mappend tag . contents
882− (E.string tagFieldName ><
931+ where
883− E.colon ><
932+ tag = tagFieldName `pair`
884− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
933+ (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
885− ((unTagged :: Tagged isRecord Encoding -> Encoding) .
936+ (unTagged :: Tagged isRecord pairs -> pairs) .
886− taggedObjectEnc' opts targs contentsFieldName . unM1 $ v)
937+ taggedObject' opts targs contentsFieldName . unM1
888−class TaggedObjectEnc' arity f isRecord where
939+class TaggedObject' enc pairs arity f isRecord where
889− taggedObjectEnc' :: Options -> ToArgs Encoding arity a
940+ taggedObject' :: Options -> ToArgs enc arity a
890− -> String -> f a -> Tagged isRecord Encoding
941+ -> String -> f a -> Tagged isRecord pairs
943+instance ( GToJSON enc arity f
944+ , KeyValuePair enc pairs
945+ ) => TaggedObject' enc pairs arity f False
947+ taggedObject' opts targs contentsFieldName =
948+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs
892−instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
950+instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
893− taggedObjectEnc' _ _ _ _ = Tagged E.empty
951+ taggedObject' _ _ _ _ = Tagged mempty
895−instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
953+instance ( RecordToPairs enc pairs arity f
896− taggedObjectEnc' opts targs _ = Tagged . (E.comma ><) . fst
954+ ) => TaggedObject' enc pairs arity f True
897− . recordToEncoding opts targs
955+ where
898−
956+ taggedObject' opts targs _ = Tagged . recordToPairs opts targs
899−instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
900− taggedObjectEnc' opts targs contentsFieldName =
901− Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
902− gToEncoding opts targs
904--------------------------------------------------------------------------------
958--------------------------------------------------------------------------------
@@ -914,23 +968,38 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
914instance (Constructor c) => GetConName (C1 c a) where
968instance (Constructor c) => GetConName (C1 c a) where
915 getConName = conName
969 getConName = conName
971+-- For genericToJSONKey
972+instance GetConName a => GetConName (D1 d a) where
973+ getConName (M1 x) = getConName x
917--------------------------------------------------------------------------------
975--------------------------------------------------------------------------------
919−class TwoElemArrayObj arity f where
977+-- Reflection of SumEncoding variants
920− twoElemArrayObj :: Options -> ToArgs Value arity a
978+
921− -> f a -> V.Vector Value
979+data ObjectWithSingleField
983+--------------------------------------------------------------------------------
985+class SumToJSON' s enc arity f where
986+ sumToJSON' :: Options -> ToArgs enc arity a
987+ -> f a -> Tagged s enc
923−instance ( TwoElemArrayObj arity a
989+instance ( SumToJSON' s enc arity a
924− , TwoElemArrayObj arity b
990+ , SumToJSON' s enc arity b
925− ) => TwoElemArrayObj arity (a :+: b) where
991+ ) => SumToJSON' s enc arity (a :+: b)
926− twoElemArrayObj opts targs (L1 x) = twoElemArrayObj opts targs x
993+ sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
927− twoElemArrayObj opts targs (R1 x) = twoElemArrayObj opts targs x
994+ sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
996+--------------------------------------------------------------------------------
929−instance ( GToJSON arity a
998+instance ( GToJSON Value arity a
930− , ConsToJSON arity a
999+ , ConsToJSON Value arity a
931 , Constructor c
1000 , Constructor c
932− ) => TwoElemArrayObj arity (C1 c a) where
1001+ ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
933− twoElemArrayObj opts targs x = V.create $ do
1002+ sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
934 mv <- VM.unsafeNew 2
1003 mv <- VM.unsafeNew 2
935 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1004 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
936 $ conName (undefined :: t c a p)
1005 $ conName (undefined :: t c a p)
@@ -939,148 +1008,121 @@ instance ( GToJSON arity a
940--------------------------------------------------------------------------------
1009--------------------------------------------------------------------------------
942−class TwoElemArrayEnc arity f where
943− twoElemArrayEnc :: Options -> ToArgs Encoding arity a
946−instance ( TwoElemArrayEnc arity a
1011+instance ( GToJSON Encoding arity a
947− , TwoElemArrayEnc arity b
1012+ , ConsToJSON Encoding arity a
948− ) => TwoElemArrayEnc arity (a :+: b) where
949− twoElemArrayEnc opts targs (L1 x) = twoElemArrayEnc opts targs x
950− twoElemArrayEnc opts targs (R1 x) = twoElemArrayEnc opts targs x
952−instance ( GToEncoding arity a
953− , ConsToEncoding arity a
954 , Constructor c
1013 , Constructor c
955− ) => TwoElemArrayEnc arity (C1 c a) where
1014+ ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
956− twoElemArrayEnc opts targs x = E.tuple $
1015+ where
1016+ sumToJSON' opts targs x = Tagged $ E.list id
957− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
1017+ [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
958− gToEncoding opts targs x
1018+ , gToJSON opts targs x
960--------------------------------------------------------------------------------
1021--------------------------------------------------------------------------------
962−class ConsToJSON arity f where
1023+class ConsToJSON enc arity f where
963− consToJSON :: Options -> ToArgs Value arity a
1024+ consToJSON :: Options -> ToArgs enc arity a
964− -> f a -> Value
1025+ -> f a -> enc
966−class ConsToJSON' arity f isRecord where
1027+class ConsToJSON' enc arity f isRecord where
967− consToJSON' :: Options -> ToArgs Value arity a
1028+ consToJSON' :: Options -> ToArgs enc arity a
968− -> Bool -- ^ Are we a record with one field?
969− -> f a -> Tagged isRecord Value
1029+ -> f a -> Tagged isRecord enc
971−instance ( IsRecord f isRecord
1031+instance ( IsRecord f isRecord
972− , ConsToJSON' arity f isRecord
1032+ , ConsToJSON' enc arity f isRecord
973− ) => ConsToJSON arity f where
1033+ ) => ConsToJSON enc arity f
974 consToJSON opts targs =
1035 consToJSON opts targs =
975− (unTagged :: Tagged isRecord Value -> Value)
1036+ (unTagged :: Tagged isRecord enc -> enc)
976− . consToJSON' opts targs (isUnary (undefined :: f a))
1037+ . consToJSON' opts targs
977−
1038+ {-# INLINE consToJSON #-}
978−instance (RecordToPairs arity f) => ConsToJSON' arity f True where
979− consToJSON' opts targs isUn f = let
980− vals = toList $ recordToPairs opts targs f
981− in case (unwrapUnaryRecords opts,isUn,vals) of
982− (True,True,[(_,val)]) -> Tagged val
983− _ -> Tagged $ object vals
985−instance GToJSON arity f => ConsToJSON' arity f False where
986− consToJSON' opts targs _ = Tagged . gToJSON opts targs
988−--------------------------------------------------------------------------------
990−class ConsToEncoding arity f where
1040+instance OVERLAPPING_
991− consToEncoding :: Options -> ToArgs Encoding arity a
1041+ ( RecordToPairs enc pairs arity (S1 s f)
992− -> f a -> Encoding
1042+ , FromPairs enc pairs
993−
1043+ , GToJSON enc arity f
994−class ConsToEncoding' arity f isRecord where
1044+ ) => ConsToJSON' enc arity (S1 s f) True
995− consToEncoding' :: Options -> ToArgs Encoding arity a
1045+ where
996− -> Bool -- ^ Are we a record with one field?
1046+ consToJSON' opts targs
997− -> f a -> Tagged isRecord Encoding
1047+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049+ {-# INLINE consToJSON' #-}
1051+instance ( RecordToPairs enc pairs arity f
1052+ , FromPairs enc pairs
1053+ ) => ConsToJSON' enc arity f True
1055+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056+ {-# INLINE consToJSON' #-}
999−instance ( IsRecord f isRecord
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1000− , ConsToEncoding' arity f isRecord
1001− ) => ConsToEncoding arity f where
1002− consToEncoding opts targs =
1003− (unTagged :: Tagged isRecord Encoding -> Encoding)
1004− . consToEncoding' opts targs (isUnary (undefined :: f a))
1006−instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
1007− consToEncoding' opts targs isUn x =
1008− let (enc, mbVal) = recordToEncoding opts targs x
1009− in case (unwrapUnaryRecords opts, isUn, mbVal) of
1010− (True, True, Just val) -> Tagged val
1011− _ -> Tagged $ E.wrapObject enc
1013−instance GToEncoding arity f => ConsToEncoding' arity f False where
1014− consToEncoding' opts targs _ = Tagged . gToEncoding opts targs
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1060+ {-# INLINE consToJSON' #-}
1016--------------------------------------------------------------------------------
1062--------------------------------------------------------------------------------
1018−class RecordToPairs arity f where
1064+class RecordToPairs enc pairs arity f where
1065+ -- 1st element: whole thing
1066+ -- 2nd element: in case the record has only 1 field, just the value
1067+ -- of the field (without the key); 'Nothing' otherwise
1019− recordToPairs :: Options -> ToArgs Value arity a
1068+ recordToPairs :: Options -> ToArgs enc arity a
1020− -> f a -> DList Pair
1069+ -> f a -> pairs
1022−instance ( RecordToPairs arity a
1023− , RecordToPairs arity b
1024− ) => RecordToPairs arity (a :*: b) where
1025− recordToPairs opts targs (a :*: b) = recordToPairs opts targs a <>
1026− recordToPairs opts targs b
1071+instance ( Monoid pairs
1072+ , RecordToPairs enc pairs arity a
1073+ , RecordToPairs enc pairs arity b
1074+ ) => RecordToPairs enc pairs arity (a :*: b)
1076+ recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1077+ pairsOf a `mappend` pairsOf b
1079+ pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1080+ pairsOf = recordToPairs opts targs
1081+ {-# INLINE recordToPairs #-}
1083+instance ( Selector s
1084+ , GToJSON enc arity a
1085+ , KeyValuePair enc pairs
1028−instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
1086+ ) => RecordToPairs enc pairs arity (S1 s a)
1029 recordToPairs = fieldToPair
1088 recordToPairs = fieldToPair
1030−
1089+ {-# INLINE recordToPairs #-}
1091+instance INCOHERENT_
1031−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1092+ ( Selector s
1093+ , GToJSON enc arity (K1 i (Maybe a))
1094+ , KeyValuePair enc pairs
1032− RecordToPairs arity (S1 s (K1 i (Maybe a))) where
1096+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1033 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1098 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1034− , K1 Nothing <- k1 = DList.empty
1099+ , K1 Nothing <- k1 = mempty
1035 recordToPairs opts targs m1 = fieldToPair opts targs m1
1100 recordToPairs opts targs m1 = fieldToPair opts targs m1
1036−
1101+ {-# INLINE recordToPairs #-}
1037−fieldToPair :: (Selector s, GToJSON arity a)
1102+
1038− => Options -> ToArgs Value arity p
1103+instance INCOHERENT_
1039− -> S1 s a p -> DList Pair
1104+ ( Selector s
1040−fieldToPair opts targs m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1105+ , GToJSON enc arity (K1 i (Maybe a))
1041− , gToJSON opts targs (unM1 m1)
1106+ , KeyValuePair enc pairs
1042− )
1107+ , Monoid pairs
1043−
1108+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1044−--------------------------------------------------------------------------------
1109+ where
1045−
1110+ recordToPairs opts targs = recordToPairs opts targs . unwrap
1046−class RecordToEncoding arity f where
1111+ where
1047− -- 1st element: whole thing
1112+ unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
1048− -- 2nd element: in case the record has only 1 field, just the value
1113+ unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
1049− -- of the field (without the key); 'Nothing' otherwise
1114+ {-# INLINE recordToPairs #-}
1050− recordToEncoding :: Options -> ToArgs Encoding arity a
1115+
1051− -> f a -> (Encoding, Maybe Encoding)
1116+fieldToPair :: (Selector s
1052−
1117+ , GToJSON enc arity a
1053−instance ( RecordToEncoding arity a
1118+ , KeyValuePair enc pairs)
1054− , RecordToEncoding arity b
1055− ) => RecordToEncoding arity (a :*: b) where
1056− recordToEncoding opts targs (a :*: b) | omitNothingFields opts =
1057− (E.econcat $ intersperse E.comma $
1058− filter (not . E.nullEncoding)
1059− [ fst (recordToEncoding opts targs a)
1060− , fst (recordToEncoding opts targs b) ]
1062− recordToEncoding opts targs (a :*: b) =
1063− (fst (recordToEncoding opts targs a) >< E.comma ><
1064− fst (recordToEncoding opts targs b),
1068−instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1069− recordToEncoding = fieldToEncoding
1071−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1072− RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1073− recordToEncoding opts _ (M1 k1) | omitNothingFields opts
1074− , K1 Nothing <- k1 = (E.empty, Nothing)
1075− recordToEncoding opts targs m1 = fieldToEncoding opts targs m1
1077−fieldToEncoding :: (Selector s, GToEncoding arity a)
1078− => Options -> ToArgs Encoding arity p
1119+ => Options -> ToArgs enc arity p
1079− -> S1 s a p -> (Encoding, Maybe Encoding)
1120+ -> S1 s a p -> pairs
1080−fieldToEncoding opts targs m1 =
1121+fieldToPair opts targs m1 =
1081− let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1122+ let key = fieldLabelModifier opts (selName m1)
1082− valueBuilder = gToEncoding opts targs (unM1 m1)
1123+ value = gToJSON opts targs (unM1 m1)
1083− in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
1124+ in key `pair` value
1125+{-# INLINE fieldToPair #-}
1085--------------------------------------------------------------------------------
1127--------------------------------------------------------------------------------
@@ -1103,10 +1145,12 @@ instance ( WriteProduct arity a
1103 lenL = len `unsafeShiftR` 1
1145 lenL = len `unsafeShiftR` 1
1104 lenR = len - lenL
1146 lenR = len - lenL
1105 ixR = ix + lenL
1147 ixR = ix + lenL
1148+ {-# INLINE writeProduct #-}
1107−instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1150+instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1108 writeProduct opts targs mv ix _ =
1151 writeProduct opts targs mv ix _ =
1109 VM.unsafeWrite mv ix . gToJSON opts targs
1152 VM.unsafeWrite mv ix . gToJSON opts targs
1153+ {-# INLINE writeProduct #-}
1111--------------------------------------------------------------------------------
1155--------------------------------------------------------------------------------
@@ -1121,114 +1165,44 @@ instance ( EncodeProduct arity a
1121 E.econcat $ intersperse E.comma $
1165 E.econcat $ intersperse E.comma $
1122 filter (not . E.nullEncoding)
1166 filter (not . E.nullEncoding)
1123 [encodeProduct opts targs a, encodeProduct opts targs b]
1167 [encodeProduct opts targs a, encodeProduct opts targs b]
1124− encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<
1168+ encodeProduct opts targs (a :*: b) =
1169+ encodeProduct opts targs a >*<
1125− encodeProduct opts targs b
1170+ encodeProduct opts targs b
1171+ {-# INLINE encodeProduct #-}
1127−instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1173+instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1128− encodeProduct opts targs a = E.retagEncoding $ gToEncoding opts targs a
1174+ encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1175+ {-# INLINE encodeProduct #-}
1130--------------------------------------------------------------------------------
1177--------------------------------------------------------------------------------
1132−class ObjectWithSingleFieldObj arity f where
1133− objectWithSingleFieldObj :: Options -> ToArgs Value arity a
1136−instance ( ObjectWithSingleFieldObj arity a
1137− , ObjectWithSingleFieldObj arity b
1138− ) => ObjectWithSingleFieldObj arity (a :+: b) where
1139− objectWithSingleFieldObj opts targs (L1 x) =
1140− objectWithSingleFieldObj opts targs x
1141− objectWithSingleFieldObj opts targs (R1 x) =
1142− objectWithSingleFieldObj opts targs x
1144−instance ( GToJSON arity a
1179+instance ( GToJSON enc arity a
1145− , ConsToJSON arity a
1180+ , ConsToJSON enc arity a
1181+ , FromPairs enc pairs
1182+ , KeyValuePair enc pairs
1146 , Constructor c
1183 , Constructor c
1147− ) => ObjectWithSingleFieldObj arity (C1 c a) where
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1148− objectWithSingleFieldObj opts targs = H.singleton typ . gToJSON opts targs
1185+ where
1186+ sumToJSON' opts targs =
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1150− typ = pack $ constructorTagModifier opts $
1189+ typ = constructorTagModifier opts $
1151 conName (undefined :: t c a p)
1190 conName (undefined :: t c a p)
1153--------------------------------------------------------------------------------
1192--------------------------------------------------------------------------------
1155−class ObjectWithSingleFieldEnc arity f where
1156− objectWithSingleFieldEnc :: Options -> ToArgs Encoding arity a
1159−instance ( ObjectWithSingleFieldEnc arity a
1160− , ObjectWithSingleFieldEnc arity b
1161− ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1162− objectWithSingleFieldEnc opts targs (L1 x) =
1163− objectWithSingleFieldEnc opts targs x
1164− objectWithSingleFieldEnc opts targs (R1 x) =
1165− objectWithSingleFieldEnc opts targs x
1167−instance ( GToEncoding arity a
1168− , ConsToEncoding arity a
1170− ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1171− objectWithSingleFieldEnc opts targs v =
1174− (constructorTagModifier opts
1175− (conName (undefined :: t c a p))) ><
1177− gToEncoding opts targs v ><
1180−--------------------------------------------------------------------------------
1182−class UntaggedValueObj arity f where
1183− untaggedValueObj :: Options -> ToArgs Value arity a
1187− ( UntaggedValueObj arity a
1188− , UntaggedValueObj arity b
1189− ) => UntaggedValueObj arity (a :+: b)
1191− untaggedValueObj opts targs (L1 x) = untaggedValueObj opts targs x
1192− untaggedValueObj opts targs (R1 x) = untaggedValueObj opts targs x
1194instance OVERLAPPABLE_
1194instance OVERLAPPABLE_
1196− , ConsToJSON arity a
1195+ ( ConsToJSON enc arity a
1197− ) => UntaggedValueObj arity (C1 c a) where
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1198− untaggedValueObj = gToJSON
1200−instance OVERLAPPING_
1202− => UntaggedValueObj arity (C1 c U1)
1204− untaggedValueObj opts _ _ = toJSON $
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
1205− constructorTagModifier opts $ conName (undefined :: t c U1 p)
1207−--------------------------------------------------------------------------------
1209−class UntaggedValueEnc arity f where
1210− untaggedValueEnc :: Options -> ToArgs Encoding arity a
1213− ( UntaggedValueEnc arity a
1214− , UntaggedValueEnc arity b
1215− ) => UntaggedValueEnc arity (a :+: b)
1217− untaggedValueEnc opts targs (L1 x) = untaggedValueEnc opts targs x
1218− untaggedValueEnc opts targs (R1 x) = untaggedValueEnc opts targs x
1220−instance OVERLAPPABLE_
1221− ( GToEncoding arity a
1222− , ConsToEncoding arity a
1223− ) => UntaggedValueEnc arity (C1 c a)
1225− untaggedValueEnc = gToEncoding
1227instance OVERLAPPING_
1200instance OVERLAPPING_
1228− ( Constructor c )
1201+ ( Constructor c
1229− => UntaggedValueEnc arity (C1 c U1)
1202+ , FromString enc
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1231− untaggedValueEnc opts _ _ = toEncoding $
1205+ sumToJSON' opts _ _ = Tagged . fromString $
1232 constructorTagModifier opts $ conName (undefined :: t c U1 p)
1206 constructorTagModifier opts $ conName (undefined :: t c U1 p)
1234-------------------------------------------------------------------------------
1208-------------------------------------------------------------------------------
@@ -1302,6 +1276,13 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1302 toEncoding = toEncoding2
1276 toEncoding = toEncoding2
1303 {-# INLINE toEncoding #-}
1277 {-# INLINE toEncoding #-}
1279+instance ToJSON Void where
1281+ {-# INLINE toJSON #-}
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
1306instance ToJSON Bool where
1287instance ToJSON Bool where
1307 toJSON = Bool
1288 toJSON = Bool
@@ -1487,7 +1468,6 @@ instance ToJSONKey Int64 where
1487 toJSONKey = toJSONKeyTextEnc E.int64Text
1468 toJSONKey = toJSONKeyTextEnc E.int64Text
1488 {-# INLINE toJSONKey #-}
1469 {-# INLINE toJSONKey #-}
1491instance ToJSON Word where
1471instance ToJSON Word where
1492 toJSON = Number . fromIntegral
1472 toJSON = Number . fromIntegral
1493 {-# INLINE toJSON #-}
1473 {-# INLINE toJSON #-}
@@ -1547,6 +1527,12 @@ instance ToJSONKey Word64 where
1547 toJSONKey = toJSONKeyTextEnc E.word64Text
1527 toJSONKey = toJSONKeyTextEnc E.word64Text
1548 {-# 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 #-}
1551instance ToJSON Text where
1537instance ToJSON Text where
1552 toJSON = String
1538 toJSON = String
@@ -1661,7 +1647,7 @@ instance (ToJSON a) => ToJSON (Identity a) where
1661 toEncodingList = liftToEncodingList toEncoding toEncodingList
1647 toEncodingList = liftToEncodingList toEncoding toEncodingList
1662 {-# INLINE toEncodingList #-}
1648 {-# INLINE toEncodingList #-}
1664−instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
1665 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1651 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1666 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1652 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
@@ -1810,13 +1796,11 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
1810 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1796 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1811 {-# INLINE liftToJSON #-}
1797 {-# INLINE liftToJSON #-}
1813− -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
1814 liftToEncoding g _ = case toJSONKey of
1799 liftToEncoding g _ = case toJSONKey of
1815 ToJSONKeyText _ f -> dict f g M.foldrWithKey
1800 ToJSONKeyText _ f -> dict f g M.foldrWithKey
1816 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1801 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1818− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1819− pairEncoding f (a, b) = tuple $ f a >*< g b
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
1820 {-# INLINE liftToEncoding #-}
1804 {-# INLINE liftToEncoding #-}
@@ -1854,6 +1838,17 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
1854 toEncoding = toEncoding1
1838 toEncoding = toEncoding1
1855 {-# 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
1858-------------------------------------------------------------------------------
1853-------------------------------------------------------------------------------
1859-- vector
1854-- vector
@@ -1867,6 +1862,8 @@ instance ToJSON1 Vector where
1867 {-# INLINE liftToEncoding #-}
1862 {-# INLINE liftToEncoding #-}
1869instance (ToJSON a) => ToJSON (Vector a) where
1864instance (ToJSON a) => ToJSON (Vector a) where
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1870 toJSON = toJSON1
1867 toJSON = toJSON1
1871 {-# INLINE toJSON #-}
1868 {-# INLINE toJSON #-}
@@ -1934,11 +1931,12 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1934 ToJSONKeyText _ f -> dict f g H.foldrWithKey
1931 ToJSONKeyText _ f -> dict f g H.foldrWithKey
1935 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1932 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1937− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1938− pairEncoding f (a, b) = tuple $ f a >*< g b
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
1939 {-# INLINE liftToEncoding #-}
1935 {-# INLINE liftToEncoding #-}
1941instance (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 #-}
1942 toJSON = toJSON1
1940 toJSON = toJSON1
1943 {-# INLINE toJSON #-}
1941 {-# INLINE toJSON #-}
@@ -1968,6 +1966,32 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1968formatMillis :: (FormatTime t) => t -> String
1966formatMillis :: (FormatTime t) => t -> String
1969formatMillis = 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
1971-------------------------------------------------------------------------------
1995-------------------------------------------------------------------------------
1973-------------------------------------------------------------------------------
1997-------------------------------------------------------------------------------
@@ -2016,10 +2040,11 @@ stringEncoding :: Encoding' Text -> Value
2016stringEncoding = String
2040stringEncoding = String
2017 . T.dropAround (== '"')
2041 . T.dropAround (== '"')
2018 . T.decodeLatin1
2042 . T.decodeLatin1
2019− . lazyToStrictByteString
2043+ . L.toStrict
2020 . E.encodingToLazyByteString
2044 . E.encodingToLazyByteString
2021{-# INLINE stringEncoding #-}
2045{-# INLINE stringEncoding #-}
2023instance ToJSON NominalDiffTime where
2048instance ToJSON NominalDiffTime where
2024 toJSON = Number . realToFrac
2049 toJSON = Number . realToFrac
2025 {-# INLINE toJSON #-}
2050 {-# INLINE toJSON #-}
@@ -2027,18 +2052,159 @@ instance ToJSON NominalDiffTime where
2027 toEncoding = E.scientific . realToFrac
2052 toEncoding = E.scientific . realToFrac
2028 {-# 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
2030-------------------------------------------------------------------------------
2107-------------------------------------------------------------------------------
2031-- base Monoid/Semigroup
2108-- base Monoid/Semigroup
2032-------------------------------------------------------------------------------
2109-------------------------------------------------------------------------------
2034−instance ToJSON1 Dual where
2111+instance ToJSON1 Monoid.Dual where
2035− liftToJSON t _ = t . getDual
2112+ liftToJSON t _ = t . Monoid.getDual
2113+ {-# INLINE liftToJSON #-}
2115+ liftToEncoding t _ = t . Monoid.getDual
2116+ {-# INLINE liftToEncoding #-}
2118+instance ToJSON a => ToJSON (Monoid.Dual a) where
2120+ {-# INLINE toJSON #-}
2122+ toEncoding = toEncoding1
2123+ {-# INLINE toEncoding #-}
2126+instance ToJSON1 Monoid.First where
2127+ liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
2128+ {-# INLINE liftToJSON #-}
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
2131+ {-# INLINE liftToEncoding #-}
2133+instance ToJSON a => ToJSON (Monoid.First a) where
2135+ {-# INLINE toJSON #-}
2137+ toEncoding = toEncoding1
2138+ {-# INLINE toEncoding #-}
2141+instance ToJSON1 Monoid.Last where
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2143+ {-# INLINE liftToJSON #-}
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2146+ {-# INLINE liftToEncoding #-}
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
2036 {-# INLINE liftToJSON #-}
2202 {-# INLINE liftToJSON #-}
2038− liftToEncoding t _ = t . getDual
2204+ liftToEncoding t _ (Semigroup.Last x) = t x
2039 {-# INLINE liftToEncoding #-}
2205 {-# INLINE liftToEncoding #-}
2041−instance ToJSON a => ToJSON (Dual a) where
2207+instance ToJSON a => ToJSON (Semigroup.Last a) where
2042 toJSON = toJSON1
2208 toJSON = toJSON1
2043 {-# INLINE toJSON #-}
2209 {-# INLINE toJSON #-}
@@ -2046,14 +2212,14 @@ instance ToJSON a => ToJSON (Dual a) where
2046 {-# INLINE toEncoding #-}
2212 {-# INLINE toEncoding #-}
2049−instance ToJSON1 First where
2215+instance ToJSON1 Semigroup.WrappedMonoid where
2050− liftToJSON t to' = liftToJSON t to' . getFirst
2216+ liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2051 {-# INLINE liftToJSON #-}
2217 {-# INLINE liftToJSON #-}
2053− liftToEncoding t to' = liftToEncoding t to' . getFirst
2219+ liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2054 {-# INLINE liftToEncoding #-}
2220 {-# INLINE liftToEncoding #-}
2056−instance ToJSON a => ToJSON (First a) where
2222+instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2057 toJSON = toJSON1
2223 toJSON = toJSON1
2058 {-# INLINE toJSON #-}
2224 {-# INLINE toJSON #-}
@@ -2061,14 +2227,14 @@ instance ToJSON a => ToJSON (First a) where
2061 {-# INLINE toEncoding #-}
2227 {-# INLINE toEncoding #-}
2064−instance ToJSON1 Last where
2230+instance ToJSON1 Semigroup.Option where
2065− liftToJSON t to' = liftToJSON t to' . getLast
2231+ liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2066 {-# INLINE liftToJSON #-}
2232 {-# INLINE liftToJSON #-}
2068− liftToEncoding t to' = liftToEncoding t to' . getLast
2234+ liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2069 {-# INLINE liftToEncoding #-}
2235 {-# INLINE liftToEncoding #-}
2071−instance ToJSON a => ToJSON (Last a) where
2237+instance ToJSON a => ToJSON (Semigroup.Option a) where
2072 toJSON = toJSON1
2238 toJSON = toJSON1
2073 {-# INLINE toJSON #-}
2239 {-# INLINE toJSON #-}
@@ -2079,6 +2245,13 @@ instance ToJSON a => ToJSON (Last a) where
2079-- tagged
2245-- tagged
2080-------------------------------------------------------------------------------
2246-------------------------------------------------------------------------------
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
2082instance ToJSON (Proxy a) where
2255instance ToJSON (Proxy a) where
2083 toJSON _ = Null
2256 toJSON _ = Null
2084 {-# INLINE toJSON #-}
2257 {-# INLINE toJSON #-}
@@ -2087,6 +2260,13 @@ instance ToJSON (Proxy a) where
2087 {-# 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 #-}
2090instance ToJSON1 (Tagged a) where
2270instance ToJSON1 (Tagged a) where
2091 liftToJSON t _ (Tagged x) = t x
2271 liftToJSON t _ (Tagged x) = t x
2092 {-# INLINE liftToJSON #-}
2272 {-# INLINE liftToJSON #-}
@@ -2101,7 +2281,6 @@ instance ToJSON b => ToJSON (Tagged a b) where
2101 toEncoding = toEncoding1
2281 toEncoding = toEncoding1
2102 {-# INLINE toEncoding #-}
2282 {-# INLINE toEncoding #-}
2105instance ToJSONKey b => ToJSONKey (Tagged a b) where
2284instance ToJSONKey b => ToJSONKey (Tagged a b) where
2106 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2107 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2122,7 +2301,7 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2122 toJSONKey = toJSONKeyList
2301 toJSONKey = toJSONKeyList
2124-------------------------------------------------------------------------------
2303-------------------------------------------------------------------------------
2125−-- Tuple instances, see tuple-instances-to.hs
2304+-- Tuple instances
2126-------------------------------------------------------------------------------
2305-------------------------------------------------------------------------------
2128instance ToJSON2 (,) where
2307instance ToJSON2 (,) where
@@ -2133,9 +2312,7 @@ instance ToJSON2 (,) where
2133 return mv
2312 return mv
2134 {-# INLINE liftToJSON2 #-}
2313 {-# INLINE liftToJSON2 #-}
2136− liftToEncoding2 toA _ toB _ (a, b) = tuple $
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2139 {-# INLINE liftToEncoding2 #-}
2316 {-# INLINE liftToEncoding2 #-}
2141instance (ToJSON a) => ToJSON1 ((,) a) where
2318instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2159,10 +2336,11 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
2159 return mv
2336 return mv
2160 {-# INLINE liftToJSON2 #-}
2337 {-# INLINE liftToJSON2 #-}
2162− liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2163− toEncoding a >*<
2340+ [ toEncoding a
2164− toB b >*<
2341+ , toB b
2166 {-# INLINE liftToEncoding2 #-}
2344 {-# INLINE liftToEncoding2 #-}
2168instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
2346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2187,11 +2365,12 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
2187 return mv
2365 return mv
2188 {-# INLINE liftToJSON2 #-}
2366 {-# INLINE liftToJSON2 #-}
2190− liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2191− toEncoding a >*<
2369+ [ toEncoding a
2192− toEncoding b >*<
2370+ , toEncoding b
2193− toC c >*<
2371+ , toC c
2195 {-# INLINE liftToEncoding2 #-}
2374 {-# INLINE liftToEncoding2 #-}
2197instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
2376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2217,12 +2396,13 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
2217 return mv
2396 return mv
2218 {-# INLINE liftToJSON2 #-}
2397 {-# INLINE liftToJSON2 #-}
2220− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2221− toEncoding a >*<
2400+ [ toEncoding a
2222− toEncoding b >*<
2401+ , toEncoding b
2223− toEncoding c >*<
2402+ , toEncoding c
2224− toD d >*<
2403+ , toD d
2226 {-# INLINE liftToEncoding2 #-}
2406 {-# INLINE liftToEncoding2 #-}
2228instance (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
@@ -2249,13 +2429,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
2249 return mv
2429 return mv
2250 {-# INLINE liftToJSON2 #-}
2430 {-# INLINE liftToJSON2 #-}
2252− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2253− toEncoding a >*<
2433+ [ toEncoding a
2254− toEncoding b >*<
2434+ , toEncoding b
2255− toEncoding c >*<
2435+ , toEncoding c
2256− toEncoding d >*<
2436+ , toEncoding d
2257− toE e >*<
2437+ , toE e
2259 {-# INLINE liftToEncoding2 #-}
2440 {-# INLINE liftToEncoding2 #-}
2261instance (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
@@ -2283,14 +2464,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
2283 return mv
2464 return mv
2284 {-# INLINE liftToJSON2 #-}
2465 {-# INLINE liftToJSON2 #-}
2286− 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
2287− toEncoding a >*<
2468+ [ toEncoding a
2288− toEncoding b >*<
2469+ , toEncoding b
2289− toEncoding c >*<
2470+ , toEncoding c
2290− toEncoding d >*<
2471+ , toEncoding d
2291− toEncoding e >*<
2472+ , toEncoding e
2292− toF f >*<
2473+ , toF f
2294 {-# INLINE liftToEncoding2 #-}
2476 {-# INLINE liftToEncoding2 #-}
2296instance (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
@@ -2319,15 +2501,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
2319 return mv
2501 return mv
2320 {-# INLINE liftToJSON2 #-}
2502 {-# INLINE liftToJSON2 #-}
2322− 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
2323− toEncoding a >*<
2505+ [ toEncoding a
2324− toEncoding b >*<
2506+ , toEncoding b
2325− toEncoding c >*<
2507+ , toEncoding c
2326− toEncoding d >*<
2508+ , toEncoding d
2327− toEncoding e >*<
2509+ , toEncoding e
2328− toEncoding f >*<
2510+ , toEncoding f
2329− toG g >*<
2511+ , toG g
2331 {-# INLINE liftToEncoding2 #-}
2514 {-# INLINE liftToEncoding2 #-}
2333instance (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
@@ -2357,16 +2540,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
2357 return mv
2540 return mv
2358 {-# INLINE liftToJSON2 #-}
2541 {-# INLINE liftToJSON2 #-}
2360− 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
2361− toEncoding a >*<
2544+ [ toEncoding a
2362− toEncoding b >*<
2545+ , toEncoding b
2363− toEncoding c >*<
2546+ , toEncoding c
2364− toEncoding d >*<
2547+ , toEncoding d
2365− toEncoding e >*<
2548+ , toEncoding e
2366− toEncoding f >*<
2549+ , toEncoding f
2367− toEncoding g >*<
2550+ , toEncoding g
2368− toH h >*<
2551+ , toH h
2370 {-# INLINE liftToEncoding2 #-}
2554 {-# INLINE liftToEncoding2 #-}
2372instance (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
@@ -2397,17 +2581,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2397 return mv
2581 return mv
2398 {-# INLINE liftToJSON2 #-}
2582 {-# INLINE liftToJSON2 #-}
2400− 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
2401− toEncoding a >*<
2585+ [ toEncoding a
2402− toEncoding b >*<
2586+ , toEncoding b
2403− toEncoding c >*<
2587+ , toEncoding c
2404− toEncoding d >*<
2588+ , toEncoding d
2405− toEncoding e >*<
2589+ , toEncoding e
2406− toEncoding f >*<
2590+ , toEncoding f
2407− toEncoding g >*<
2591+ , toEncoding g
2408− toEncoding h >*<
2592+ , toEncoding h
2409− toI i >*<
2593+ , toI i
2411 {-# INLINE liftToEncoding2 #-}
2596 {-# INLINE liftToEncoding2 #-}
2413instance (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
@@ -2439,18 +2624,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2439 return mv
2624 return mv
2440 {-# INLINE liftToJSON2 #-}
2625 {-# INLINE liftToJSON2 #-}
2442− 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
2443− toEncoding a >*<
2628+ [ toEncoding a
2444− toEncoding b >*<
2629+ , toEncoding b
2445− toEncoding c >*<
2630+ , toEncoding c
2446− toEncoding d >*<
2631+ , toEncoding d
2447− toEncoding e >*<
2632+ , toEncoding e
2448− toEncoding f >*<
2633+ , toEncoding f
2449− toEncoding g >*<
2634+ , toEncoding g
2450− toEncoding h >*<
2635+ , toEncoding h
2451− toEncoding i >*<
2636+ , toEncoding i
2452− toJ j >*<
2637+ , toJ j
2454 {-# INLINE liftToEncoding2 #-}
2640 {-# INLINE liftToEncoding2 #-}
2456instance (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
@@ -2483,19 +2669,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2483 return mv
2669 return mv
2484 {-# INLINE liftToJSON2 #-}
2670 {-# INLINE liftToJSON2 #-}
2486− 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
2487− toEncoding a >*<
2673+ [ toEncoding a
2488− toEncoding b >*<
2674+ , toEncoding b
2489− toEncoding c >*<
2675+ , toEncoding c
2490− toEncoding d >*<
2676+ , toEncoding d
2491− toEncoding e >*<
2677+ , toEncoding e
2492− toEncoding f >*<
2678+ , toEncoding f
2493− toEncoding g >*<
2679+ , toEncoding g
2494− toEncoding h >*<
2680+ , toEncoding h
2495− toEncoding i >*<
2681+ , toEncoding i
2496− toEncoding j >*<
2682+ , toEncoding j
2497− toK k >*<
2683+ , toK k
2499 {-# INLINE liftToEncoding2 #-}
2686 {-# INLINE liftToEncoding2 #-}
2501instance (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
@@ -2529,20 +2716,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2529 return mv
2716 return mv
2530 {-# INLINE liftToJSON2 #-}
2717 {-# INLINE liftToJSON2 #-}
2532− 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
2533− toEncoding a >*<
2720+ [ toEncoding a
2534− toEncoding b >*<
2721+ , toEncoding b
2535− toEncoding c >*<
2722+ , toEncoding c
2536− toEncoding d >*<
2723+ , toEncoding d
2537− toEncoding e >*<
2724+ , toEncoding e
2538− toEncoding f >*<
2725+ , toEncoding f
2539− toEncoding g >*<
2726+ , toEncoding g
2540− toEncoding h >*<
2727+ , toEncoding h
2541− toEncoding i >*<
2728+ , toEncoding i
2542− toEncoding j >*<
2729+ , toEncoding j
2543− toEncoding k >*<
2730+ , toEncoding k
2544− toL l >*<
2731+ , toL l
2546 {-# INLINE liftToEncoding2 #-}
2734 {-# INLINE liftToEncoding2 #-}
2548instance (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
@@ -2577,21 +2765,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2577 return mv
2765 return mv
2578 {-# INLINE liftToJSON2 #-}
2766 {-# INLINE liftToJSON2 #-}
2580− 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
2581− toEncoding a >*<
2769+ [ toEncoding a
2582− toEncoding b >*<
2770+ , toEncoding b
2583− toEncoding c >*<
2771+ , toEncoding c
2584− toEncoding d >*<
2772+ , toEncoding d
2585− toEncoding e >*<
2773+ , toEncoding e
2586− toEncoding f >*<
2774+ , toEncoding f
2587− toEncoding g >*<
2775+ , toEncoding g
2588− toEncoding h >*<
2776+ , toEncoding h
2589− toEncoding i >*<
2777+ , toEncoding i
2590− toEncoding j >*<
2778+ , toEncoding j
2591− toEncoding k >*<
2779+ , toEncoding k
2592− toEncoding l >*<
2780+ , toEncoding l
2593− toM m >*<
2781+ , toM m
2595 {-# INLINE liftToEncoding2 #-}
2784 {-# INLINE liftToEncoding2 #-}
2597instance (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
@@ -2627,22 +2816,23 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2627 return mv
2816 return mv
2628 {-# INLINE liftToJSON2 #-}
2817 {-# INLINE liftToJSON2 #-}
2630− 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
2631− toEncoding a >*<
2820+ [ toEncoding a
2632− toEncoding b >*<
2821+ , toEncoding b
2633− toEncoding c >*<
2822+ , toEncoding c
2634− toEncoding d >*<
2823+ , toEncoding d
2635− toEncoding e >*<
2824+ , toEncoding e
2636− toEncoding f >*<
2825+ , toEncoding f
2637− toEncoding g >*<
2826+ , toEncoding g
2638− toEncoding h >*<
2827+ , toEncoding h
2639− toEncoding i >*<
2828+ , toEncoding i
2640− toEncoding j >*<
2829+ , toEncoding j
2641− toEncoding k >*<
2830+ , toEncoding k
2642− toEncoding l >*<
2831+ , toEncoding l
2643− toEncoding m >*<
2832+ , toEncoding m
2644− toN n >*<
2833+ , toN n
2646 {-# INLINE liftToEncoding2 #-}
2836 {-# INLINE liftToEncoding2 #-}
2648instance (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
@@ -2657,27 +2847,26 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2657 toEncoding = toEncoding2
2847 toEncoding = toEncoding2
2658 {-# INLINE toEncoding #-}
2848 {-# INLINE toEncoding #-}
2660−-------------------------------------------------------------------------------
2850+--------------------------------------------------------------------------------
2661−-- pre-bytestring-0.10 compatibility
2662−-------------------------------------------------------------------------------
2664−{-# INLINE lazyToStrictByteString #-}
2852+-- | Wrap a list of pairs as an object.
2665−lazyToStrictByteString :: L.ByteString -> S.ByteString
2853+class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2666−#if MIN_VERSION_bytestring(0,10,0)
2854+ fromPairs :: pairs -> enc
2667−lazyToStrictByteString = L.toStrict
2669−lazyToStrictByteString = packChunks
2671−-- packChunks is taken from the blaze-builder package.
2856+instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857+ fromPairs = E.pairs
2673−-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
2859+instance FromPairs Value (DList Pair) where
2674−packChunks :: L.ByteString -> S.ByteString
2860+ fromPairs = object . toList
2675−packChunks lbs = do
2861+
2676− S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
2862+-- | Like 'KeyValue' but the value is already converted to JSON
2677− where
2863+-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2678− copyChunks !L.Empty !_pf = return ()
2864+-- so it can be readily concatenated.
2679− copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
2865+class Monoid kv => KeyValuePair v kv where
2680− withForeignPtr fpbuf $ \pbuf ->
2866+ pair :: String -> v -> kv
2681− copyBytes pf (pbuf `plusPtr` o) l
2867+
2682− copyChunks lbs' (pf `plusPtr` l)
2868+instance (v ~ Value) => KeyValuePair v (DList Pair) where
2683−#endif
2869+ pair k v = DList.singleton (pack k .= v)
2871+instance (e ~ Encoding) => KeyValuePair e Series where