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