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