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