@@ -1,27 +1,30 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE BangPatterns #-}
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 #-}
23−module Data.Aeson.Types.ToJSON
27+module Data.Aeson.Types.ToJSON (
25 -- * Core JSON classes
28 -- * Core JSON classes
26 ToJSON(..)
29 ToJSON(..)
27 -- * Liftings to unary and binary type constructors
30 -- * Liftings to unary and binary type constructors
@@ -33,6 +36,7 @@ module Data.Aeson.Types.ToJSON
33 , toEncoding2
36 , toEncoding2
34 -- * Generic JSON classes
37 -- * Generic JSON classes
35 , GToJSON(..)
38 , GToJSON(..)
36 , ToArgs(..)
40 , ToArgs(..)
37 , genericToJSON
41 , genericToJSON
38 , genericToEncoding
42 , genericToEncoding
@@ -43,101 +47,87 @@ module Data.Aeson.Types.ToJSON
43 , ToJSONKeyFunction(..)
47 , ToJSONKeyFunction(..)
44 , toJSONKeyText
48 , toJSONKeyText
45 , contramapToJSONKeyFunction
49 , contramapToJSONKeyFunction
50 -- * Object key-value pairs
50 -- * Object key-value pairs
51 , KeyValue(..)
51 , KeyValue(..)
54 -- * Functions needed for documentation
52 -- * Functions needed for documentation
55 -- * Encoding functions
53 -- * Encoding functions
56 , listEncoding
54 , listEncoding
57 , listValue
55 , listValue
60import Prelude.Compat
59import Prelude.Compat
62−import Control.Applicative (Const(..))
63−import Control.Monad.ST (ST)
64−import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
61+import Data.Aeson.Encoding.Internal (Encoding, Encoding', Series, dict,
65−import Data.Aeson.Encoding.Internal ((>*<))
62+ emptyArray_, tuple, (>*<), (><))
66import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
63import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67−import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
64+import Data.Aeson.Types.Generic
68import Data.Aeson.Types.Internal
65import Data.Aeson.Types.Internal
67+-- We need internal here for generic deriving
68+import qualified Data.Aeson.Encoding.Internal as E
70+import Control.Applicative (Const (..))
71+import Control.Monad.ST (ST)
69−import Data.Attoparsec.Number (Number(..))
72+import Data.Attoparsec.Number (Number (..))
70−import Data.Bits (unsafeShiftR)
73+import Data.Bits (unsafeShiftR)
71−import Data.DList (DList)
74+import Data.DList (DList)
72−import Data.Fixed (Fixed, HasResolution, Nano)
75+import Data.Fixed (Fixed, HasResolution)
73−import Data.Foldable (toList)
76+import Data.Foldable (toList)
74−import Data.Functor.Compose (Compose(..))
77+import Data.Functor.Compose (Compose (..))
75−import Data.Functor.Contravariant (Contravariant (..))
76−import Data.Functor.Identity (Identity(..))
78+import Data.Functor.Identity (Identity (..))
77−import Data.Functor.Product (Product(..))
79+import Data.Functor.Product (Product (..))
78−import Data.Functor.Sum (Sum(..))
80+import Data.Functor.Sum (Sum (..))
79−import Data.Int (Int16, Int32, Int64, Int8)
81+import Data.Int (Int16, Int32, Int64, Int8)
80−import Data.List (intersperse)
82+import Data.List (intersperse)
81−import Data.List.NonEmpty (NonEmpty(..))
83+import Data.List.NonEmpty (NonEmpty (..))
82−import Data.Semigroup ((<>))
84+import Data.Monoid (Dual (..), First (..), Last (..), (<>))
83−import Data.Proxy (Proxy(..))
85+import Data.Proxy (Proxy (..))
84−import Data.Ratio (Ratio, denominator, numerator)
86+import Data.Ratio (Ratio, denominator, numerator)
85−import Data.Scientific (Scientific)
87+import Data.Scientific (Scientific)
86−import Data.Tagged (Tagged(..))
88+import Data.Tagged (Tagged (..))
87−import Data.Text (Text, pack)
89+import Data.Text (Text, pack)
88−import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
90+import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay,
89−import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
91+ UTCTime, ZonedTime)
90−import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
91−import Data.Time.Clock.System.Compat (SystemTime (..))
92−import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
92+import Data.Time.Format (FormatTime, formatTime)
93+import Data.Time.Locale.Compat (defaultTimeLocale)
93−import Data.Vector (Vector)
94+import Data.Vector (Vector)
94−import Data.Version (Version, showVersion)
95+import Data.Version (Version, showVersion)
95−import Data.Void (Void, absurd)
96−import Data.Word (Word16, Word32, Word64, Word8)
96+import Data.Word (Word16, Word32, Word64, Word8)
97−import Foreign.Storable (Storable)
97+import Foreign.Storable (Storable)
98−import Foreign.C.Types (CTime (..))
99import GHC.Generics
98import GHC.Generics
100−import Numeric.Natural (Natural)
99+import Numeric.Natural (Natural)
101−import qualified Data.Aeson.Encoding as E
100+
102−import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
101+import qualified Data.ByteString as S
103−import qualified Data.ByteString.Lazy as L
102+import qualified Data.ByteString.Lazy as L
104−import qualified Data.DList as DList
103+import qualified Data.DList as DList
105−import qualified Data.HashMap.Strict as H
104+import qualified Data.HashMap.Strict as H
106−import qualified Data.HashSet as HashSet
105+import qualified Data.HashSet as HashSet
107−import qualified Data.IntMap as IntMap
106+import qualified Data.IntMap as IntMap
108−import qualified Data.IntSet as IntSet
107+import qualified Data.IntSet as IntSet
109−import qualified Data.List.NonEmpty as NE
108+import qualified Data.List.NonEmpty as NE
110−import qualified Data.Map as M
109+import qualified Data.Map as M
111−import qualified Data.Monoid as Monoid
112−import qualified Data.Scientific as Scientific
110+import qualified Data.Scientific as Scientific
113−import qualified Data.Semigroup as Semigroup
114−import qualified Data.Sequence as Seq
111+import qualified Data.Sequence as Seq
115−import qualified Data.Set as Set
112+import qualified Data.Set as Set
116−import qualified Data.Text as T
113+import qualified Data.Text as T
117−import qualified Data.Text.Encoding as T
114+import qualified Data.Text.Encoding as T
118−import qualified Data.Text.Lazy as LT
115+import qualified Data.Text.Lazy as LT
119−import qualified Data.Tree as Tree
116+import qualified Data.Tree as Tree
120−import qualified Data.UUID.Types as UUID
121−import qualified Data.Vector as V
117+import qualified Data.Vector as V
122−import qualified Data.Vector.Generic as VG
118+import qualified Data.Vector.Generic as VG
123−import qualified Data.Vector.Mutable as VM
119+import qualified Data.Vector.Mutable as VM
124import qualified Data.Vector.Primitive as VP
120import qualified Data.Vector.Primitive as VP
125−import qualified Data.Vector.Storable as VS
121+import qualified Data.Vector.Storable as VS
126−import qualified Data.Vector.Unboxed as VU
122+import qualified Data.Vector.Unboxed as VU
128−import qualified Data.Aeson.Encoding.Builder as EB
129−import qualified Data.ByteString.Builder as B
131−import qualified GHC.Exts as Exts
124+#if !(MIN_VERSION_bytestring(0,10,0))
132−import qualified Data.Primitive.Array as PM
125+import Foreign.ForeignPtr (withForeignPtr)
133−import qualified Data.Primitive.SmallArray as PM
126+import Foreign.Marshal.Utils (copyBytes)
134−import qualified Data.Primitive.Types as PM
127+import Foreign.Ptr (plusPtr)
136−#if MIN_VERSION_primitive(0,6,4)
137−#if !MIN_VERSION_primitive(0,7,0)
138−import qualified Data.Primitive.UnliftedArray as PM
129+import qualified Data.ByteString.Internal as S
140−import qualified Data.Primitive.PrimArray as PM
130+import qualified Data.ByteString.Lazy.Internal as L
143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
133toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
@@ -156,16 +146,19 @@ realFloatToJSON d
157-- | Class of generic representation types that can be converted to
147-- | Class of generic representation types that can be converted to
159−class GToJSON enc arity f where
149+class GToJSON arity f where
160 -- | This method (applied to 'defaultOptions') is used as the
150 -- | This method (applied to 'defaultOptions') is used as the
161− -- default generic implementation of 'toJSON'
151+ -- 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').
152+ -- or 'liftToJSON' (if the @arity@ is 'One').
164− --
153+ gToJSON :: Options -> ToArgs Value arity a -> f a -> Value
155+-- | Class of generic representation types that can be converted to
156+-- a JSON 'Encoding'.
157+class GToEncoding arity f where
158+ -- | This method (applied to 'defaultOptions') can be used as the
165− -- It also provides a generic implementation of 'toEncoding'
159+ -- 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').
160+ -- or 'liftToEncoding' (if the @arity@ is 'One').
168− gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
161+ gToEncoding :: Options -> ToArgs Encoding arity a -> f a -> Encoding
170-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
163-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
171-- function arguments that encode occurrences of the type parameter (for
164-- function arguments that encode occurrences of the type parameter (for
@@ -177,14 +170,14 @@ data ToArgs res arity a where
177-- | A configurable generic JSON creator. This function applied to
170-- | A configurable generic JSON creator. This function applied to
178-- 'defaultOptions' is used as the default for 'toJSON' when the type
171-- 'defaultOptions' is used as the default for 'toJSON' when the type
179-- is an instance of 'Generic'.
172-- is an instance of 'Generic'.
180−genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
173+genericToJSON :: (Generic a, GToJSON Zero (Rep a))
181 => Options -> a -> Value
174 => Options -> a -> Value
182genericToJSON opts = gToJSON opts NoToArgs . from
175genericToJSON opts = gToJSON opts NoToArgs . from
184-- | A configurable generic JSON creator. This function applied to
177-- | A configurable generic JSON creator. This function applied to
185-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
178-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186-- is an instance of 'Generic1'.
179-- is an instance of 'Generic1'.
187−genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
180+genericLiftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
188 => Options -> (a -> Value) -> ([a] -> Value)
181 => Options -> (a -> Value) -> ([a] -> Value)
189 -> f a -> Value
182 -> f a -> Value
190genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
183genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
@@ -192,17 +185,17 @@ genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
192-- | A configurable generic JSON encoder. This function applied to
185-- | A configurable generic JSON encoder. This function applied to
193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
186-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194-- is an instance of 'Generic'.
187-- is an instance of 'Generic'.
195−genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
188+genericToEncoding :: (Generic a, GToEncoding Zero (Rep a))
196 => Options -> a -> Encoding
189 => Options -> a -> Encoding
197−genericToEncoding opts = gToJSON opts NoToArgs . from
190+genericToEncoding opts = gToEncoding opts NoToArgs . from
199-- | A configurable generic JSON encoder. This function applied to
192-- | A configurable generic JSON encoder. This function applied to
200-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
193-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201-- is an instance of 'Generic1'.
194-- is an instance of 'Generic1'.
202−genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
195+genericLiftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
203 => Options -> (a -> Encoding) -> ([a] -> Encoding)
196 => Options -> (a -> Encoding) -> ([a] -> Encoding)
204 -> f a -> Encoding
197 -> f a -> Encoding
205−genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
198+genericLiftToEncoding opts te tel = gToEncoding opts (To1Args te tel) . from1
207-------------------------------------------------------------------------------
200-------------------------------------------------------------------------------
@@ -210,9 +203,6 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
211-- | A type that can be converted to JSON.
204-- | 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:
206-- An example type and instance:
@@ -221,10 +211,10 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
222-- data Coord = Coord { x :: Double, y :: Double }
212-- data Coord = Coord { x :: Double, y :: Double }
224−-- instance 'ToJSON' Coord where
214+-- instance ToJSON Coord where
225−-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
215+-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
227−-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
217+-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
230-- Instead of manually writing your 'ToJSON' instance, there are two options
220-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -232,15 +222,17 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
223-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234-- instance at compile time. The generated instance is optimized for your type
224-- instance at compile time. The generated instance is optimized for your type
235−-- so it will probably be more efficient than the following option.
225+-- so will probably be more efficient than the following two options:
237-- * The compiler can provide a default generic implementation for
227-- * The compiler can provide a default generic implementation for
238-- 'toJSON'.
228-- 'toJSON'.
240-- To use the second, simply add a @deriving 'Generic'@ clause to your
230-- 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
231+-- datatype and declare a 'ToJSON' instance for your datatype without giving
242−-- 'defaultOptions', it is sufficient to write (and this is the only
232+-- definitions for 'toJSON' or 'toEncoding'.
243−-- alternative where the default 'toJSON' implementation is sufficient):
233+--
234+-- For example, the previous example can be simplified to a more
246-- {-\# LANGUAGE DeriveGeneric \#-}
238-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -249,46 +241,35 @@ genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
242-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
252−-- instance 'ToJSON' Coord where
244+-- instance ToJSON Coord where
253−-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
245+-- toEncoding = 'genericToEncoding' 'defaultOptions'
256−-- If on the other hand you wish to customize the generic decoding, you have
248+-- Why do we provide an implementation for 'toEncoding' here? The
257−-- to implement both methods:
249+-- 'toEncoding' function is a relatively new addition to this class.
250+-- To allow users of older versions of this library to upgrade without
251+-- having to edit all of their instances or encounter surprising
252+-- incompatibilities, the default implementation of 'toEncoding' uses
253+-- 'toJSON'. This produces correct results, but since it performs an
254+-- intermediate conversion to a 'Value', it will be less efficient
255+-- than directly emitting an 'Encoding'. Our one-liner definition of
256+-- 'toEncoding' above bypasses the intermediate 'Value'.
258+-- If @DefaultSignatures@ doesn't give exactly the results you want,
259+-- you can customize the generic encoding with only a tiny amount of
260+-- effort, using 'genericToJSON' and 'genericToEncoding' with your
261+-- preferred 'Options':
260−-- customOptions = 'defaultOptions'
261−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
264−-- instance 'ToJSON' Coord where
264+-- instance ToJSON Coord where
265−-- 'toJSON' = 'genericToJSON' customOptions
265+-- toJSON = 'genericToJSON' 'defaultOptions'
266−-- 'toEncoding' = 'genericToEncoding' customOptions
266+-- 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
268class ToJSON a where
288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
269 -- | Convert a Haskell value to a JSON-friendly intermediate type.
289 toJSON :: a -> Value
270 toJSON :: a -> Value
291− default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
272+ default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
292 toJSON = genericToJSON defaultOptions
273 toJSON = genericToJSON defaultOptions
294 -- | Encode a Haskell value as JSON.
275 -- | Encode a Haskell value as JSON.
@@ -305,8 +286,8 @@ class ToJSON a where
305 -- extension, and then have GHC generate a method body as follows.
286 -- extension, and then have GHC generate a method body as follows.
308− -- instance 'ToJSON' Coord where
289+ -- instance ToJSON Coord where
309− -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
290+ -- toEncoding = 'genericToEncoding' 'defaultOptions'
312 toEncoding :: a -> Encoding
293 toEncoding :: a -> Encoding
@@ -338,13 +319,6 @@ instance KeyValue Pair where
338 name .= value = (name, toJSON value)
319 name .= value = (name, toJSON value)
339 {-# INLINE (.=) #-}
320 {-# 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-------------------------------------------------------------------------------
322-------------------------------------------------------------------------------
349-- Classes and types for map keys
323-- Classes and types for map keys
350-------------------------------------------------------------------------------
324-------------------------------------------------------------------------------
@@ -402,7 +376,7 @@ instance KeyValue Object where
402-- newtype wrapper around 'Text'. The recommended approach is to use
376-- newtype wrapper around 'Text'. The recommended approach is to use
403-- generalized newtype deriving:
377-- generalized newtype deriving:
405−-- > newtype RecordId = RecordId { getRecordId :: Text }
379+-- > newtype RecordId = RecordId { getRecordId :: Text}
406-- > deriving (Eq,Ord,ToJSONKey)
380-- > deriving (Eq,Ord,ToJSONKey)
408-- Then we may write:
382-- Then we may write:
@@ -417,18 +391,8 @@ instance KeyValue Object where
418-- It is possible to get the 'ToJSONKey' instance for free as we did
392-- 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
393-- 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
394+-- and from 'Text' that does not require any escape sequences. So, in
421−-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
395+-- 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':
396-- The 'Show' instance can be used to help write 'ToJSONKey':
434-- > instance ToJSONKey Color where
398-- > instance ToJSONKey Color where
@@ -503,42 +467,16 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
503 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
467 -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504 tot = T.dropAround (== '"')
468 tot = T.dropAround (== '"')
505 . T.decodeLatin1
469 . T.decodeLatin1
506− . L.toStrict
470+ . lazyToStrictByteString
507 . E.encodingToLazyByteString
471 . E.encodingToLazyByteString
510−instance Contravariant ToJSONKeyFunction where
511− contramap = contramapToJSONKeyFunction
513-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
474-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
475contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515contramapToJSONKeyFunction h x = case x of
476contramapToJSONKeyFunction h x = case x of
516 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
477 ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
517 ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
478 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-------------------------------------------------------------------------------
480-------------------------------------------------------------------------------
543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
481-- Lifings of FromJSON and ToJSON to unary and binary type constructors
544-------------------------------------------------------------------------------
482-------------------------------------------------------------------------------
@@ -551,7 +489,7 @@ instance GetConName f => GToJSONKey f
552-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
490-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553-- instance at compile time. The generated instance is optimized for your type
491-- instance at compile time. The generated instance is optimized for your type
554−-- so it will probably be more efficient than the following option.
492+-- so will probably be more efficient than the following two options:
556-- * The compiler can provide a default generic implementation for
494-- * The compiler can provide a default generic implementation for
557-- 'toJSON1'.
495-- 'toJSON1'.
@@ -569,29 +507,23 @@ instance GetConName f => GToJSONKey f
570-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
508-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
572−-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
510+-- instance ToJSON a => ToJSON1 (Pair a)
575−-- If the default implementation doesn't give exactly the results you want,
513+-- If @DefaultSignatures@ doesn't give exactly the results you want,
576-- you can customize the generic encoding with only a tiny amount of
514-- you can customize the generic encoding with only a tiny amount of
577-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
515-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578-- your preferred 'Options':
516-- your preferred 'Options':
581−-- customOptions = 'defaultOptions'
582−-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
585−-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
519+-- instance ToJSON a => ToJSON1 (Pair a) where
586−-- 'liftToJSON' = 'genericLiftToJSON' customOptions
520+-- liftToJSON = 'genericLiftToJSON' 'defaultOptions'
587−-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
521+-- liftToEncoding = 'genericLiftToEncoding' 'defaultOptions'
590−-- See also 'ToJSON'.
591class ToJSON1 f where
523class ToJSON1 f where
592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
524 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
594− default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
526+ default liftToJSON :: (Generic1 f, GToJSON One (Rep1 f))
595 => (a -> Value) -> ([a] -> Value) -> f a -> Value
527 => (a -> Value) -> ([a] -> Value) -> f a -> Value
596 liftToJSON = genericLiftToJSON defaultOptions
528 liftToJSON = genericLiftToJSON defaultOptions
@@ -600,7 +532,7 @@ class ToJSON1 f where
601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
533 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
603− default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
535+ default liftToEncoding :: (Generic1 f, GToEncoding One (Rep1 f))
604 => (a -> Encoding) -> ([a] -> Encoding)
536 => (a -> Encoding) -> ([a] -> Encoding)
605 -> f a -> Encoding
537 -> f a -> Encoding
606 liftToEncoding = genericLiftToEncoding defaultOptions
538 liftToEncoding = genericLiftToEncoding defaultOptions
@@ -654,7 +586,7 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
655-- newtype F a = F [a]
587-- newtype F a = F [a]
657−-- -- This instance encodes 'String' as an array of chars
589+-- -- This instance encodes String as an array of chars
658-- instance 'ToJSON1' F where
590-- instance 'ToJSON1' F where
659-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
591-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
592-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
@@ -685,11 +617,6 @@ instance ToJSON1 [] where
685 {-# INLINE liftToEncoding #-}
617 {-# INLINE liftToEncoding #-}
687instance (ToJSON a) => ToJSON [a] where
619instance (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
620 toJSON = toJSON1
694 {-# INLINE toJSON #-}
621 {-# INLINE toJSON #-}
@@ -700,80 +627,39 @@ instance (ToJSON a) => ToJSON [a] where
700-- Generic toJSON / toEncoding
627-- Generic toJSON / toEncoding
701-------------------------------------------------------------------------------
628-------------------------------------------------------------------------------
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--------------------------------------------------------------------------------
630--------------------------------------------------------------------------------
745-- Generic toJSON
631-- 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
633+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
634+ -- Meta-information, which is not handled elsewhere, is ignored:
753− -- rather easy:
635+ 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
637+instance (ToJSON a) => GToJSON arity (K1 i a) where
758 -- Constant values are encoded using their ToJSON instance:
638 -- Constant values are encoded using their ToJSON instance:
759 gToJSON _opts _ = toJSON . unK1
639 gToJSON _opts _ = toJSON . unK1
760− {-# INLINE gToJSON #-}
641+instance GToJSON One Par1 where
642+ -- Direct occurrences of the last type parameter are encoded with the
643+ -- function passed in as an argument:
644+ gToJSON _opts (To1Args tj _) = tj . unPar1
762−instance ToJSON1 f => GToJSON Value One (Rec1 f) where
646+instance (ToJSON1 f) => GToJSON One (Rec1 f) where
763 -- Recursive occurrences of the last type parameter are encoded using their
647 -- Recursive occurrences of the last type parameter are encoded using their
764 -- ToJSON1 instance:
648 -- ToJSON1 instance:
765 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
649 gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766− {-# INLINE gToJSON #-}
768−instance GToJSON Value arity U1 where
651+instance GToJSON arity U1 where
769 -- Empty constructors are encoded to an empty array:
652 -- Empty constructors are encoded to an empty array:
770 gToJSON _opts _ _ = emptyArray
653 gToJSON _opts _ _ = emptyArray
771− {-# INLINE gToJSON #-}
654+
655+instance (ConsToJSON arity a) => GToJSON arity (C1 c a) where
656+ -- Constructors need to be encoded differently depending on whether they're
657+ -- a record or not. This distinction is made by 'consToJSON':
658+ gToJSON opts targs = consToJSON opts targs . unM1
773instance ( WriteProduct arity a, WriteProduct arity b
660instance ( WriteProduct arity a, WriteProduct arity b
774 , ProductSize a, ProductSize b
661 , ProductSize a, ProductSize b
775− ) => GToJSON Value arity (a :*: b)
662+ ) => GToJSON arity (a :*: b) where
777 -- Products are encoded to an array. Here we allocate a mutable vector of
663 -- 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
664 -- the same size as the product and write the product's elements to it using
779 -- 'writeProduct':
665 -- 'writeProduct':
@@ -785,175 +671,238 @@ instance ( WriteProduct arity a, WriteProduct arity b
786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
672 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787 productSize
673 productSize
788− {-# INLINE gToJSON #-}
790−instance ( ToJSON1 f
675+instance ( AllNullary (a :+: b) allNullary
791− , GToJSON Value One g
676+ , SumToJSON arity (a :+: b) allNullary
792− ) => GToJSON Value One (f :.: g)
677+ ) => GToJSON arity (a :+: b) where
793− where
678+ -- If all constructors of a sum datatype are nullary and the
679+ -- 'allNullaryToStringTag' option is set they are encoded to
680+ -- strings. This distinction is made by 'sumToJSON':
681+ gToJSON opts targs = (unTagged :: Tagged allNullary Value -> Value)
682+ . sumToJSON opts targs
684+instance (ToJSON1 f, GToJSON One g) => GToJSON One (f :.: g) where
794 -- If an occurrence of the last type parameter is nested inside two
685 -- 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
686 -- composed types, it is encoded by using the outermost type's ToJSON1
796 -- instance to generically encode the innermost type:
687 -- instance to generically encode the innermost type:
797 gToJSON opts targs =
688 gToJSON opts targs =
798 let gtj = gToJSON opts targs in
689 let gtj = gToJSON opts targs in
799 liftToJSON gtj (listValue gtj) . unComp1
690 liftToJSON gtj (listValue gtj) . unComp1
800− {-# INLINE gToJSON #-}
802--------------------------------------------------------------------------------
692--------------------------------------------------------------------------------
803-- Generic toEncoding
693-- Generic toEncoding
695+instance OVERLAPPABLE_ (GToEncoding arity a) => GToEncoding arity (M1 i c a) where
696+ -- Meta-information, which is not handled elsewhere, is ignored:
697+ gToEncoding opts targs = gToEncoding opts targs . unM1
805−instance ToJSON a => GToJSON Encoding arity (K1 i a) where
699+instance (ToJSON a) => GToEncoding arity (K1 i a) where
806 -- Constant values are encoded using their ToJSON instance:
700 -- Constant values are encoded using their ToJSON instance:
807− gToJSON _opts _ = toEncoding . unK1
701+ gToEncoding _opts _ = toEncoding . unK1
808− {-# INLINE gToJSON #-}
703+instance GToEncoding One Par1 where
704+ -- Direct occurrences of the last type parameter are encoded with the
705+ -- function passed in as an argument:
706+ gToEncoding _opts (To1Args te _) = te . unPar1
810−instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
708+instance (ToJSON1 f) => GToEncoding One (Rec1 f) where
811 -- Recursive occurrences of the last type parameter are encoded using their
709 -- Recursive occurrences of the last type parameter are encoded using their
812 -- ToEncoding1 instance:
710 -- ToEncoding1 instance:
813− gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
711+ gToEncoding _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814− {-# INLINE gToJSON #-}
816−instance GToJSON Encoding arity U1 where
713+instance GToEncoding arity U1 where
817 -- Empty constructors are encoded to an empty array:
714 -- Empty constructors are encoded to an empty array:
818− gToJSON _opts _ _ = E.emptyArray_
715+ gToEncoding _opts _ _ = E.emptyArray_
819− {-# INLINE gToJSON #-}
716+
717+instance (ConsToEncoding arity a) => GToEncoding arity (C1 c a) where
718+ -- Constructors need to be encoded differently depending on whether they're
719+ -- a record or not. This distinction is made by 'consToEncoding':
720+ gToEncoding opts targs = consToEncoding opts targs . unM1
821instance ( EncodeProduct arity a
722instance ( EncodeProduct arity a
822 , EncodeProduct arity b
723 , EncodeProduct arity b
823− ) => GToJSON Encoding arity (a :*: b)
724+ ) => GToEncoding arity (a :*: b) where
825 -- Products are encoded to an array. Here we allocate a mutable vector of
725 -- 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
726 -- the same size as the product and write the product's elements to it using
827 -- 'encodeProduct':
727 -- 'encodeProduct':
828− gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
728+ gToEncoding opts targs p = E.tuple $ encodeProduct opts targs p
829− {-# INLINE gToJSON #-}
831−instance ( ToJSON1 f
730+instance ( AllNullary (a :+: b) allNullary
832− , GToJSON Encoding One g
731+ , SumToEncoding arity (a :+: b) allNullary
833− ) => GToJSON Encoding One (f :.: g)
732+ ) => GToEncoding arity (a :+: b) where
834− where
733+ -- If all constructors of a sum datatype are nullary and the
734+ -- 'allNullaryToStringTag' option is set they are encoded to
735+ -- strings. This distinction is made by 'sumToEncoding':
736+ gToEncoding opts targs
737+ = (unTagged :: Tagged allNullary Encoding -> Encoding)
738+ . sumToEncoding opts targs
740+instance (ToJSON1 f, GToEncoding One g) => GToEncoding One (f :.: g) where
835 -- If an occurrence of the last type parameter is nested inside two
741 -- 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
742 -- composed types, it is encoded by using the outermost type's ToJSON1
837 -- instance to generically encode the innermost type:
743 -- instance to generically encode the innermost type:
838− gToJSON opts targs =
744+ gToEncoding opts targs =
839− let gte = gToJSON opts targs in
745+ let gte = gToEncoding opts targs in
840 liftToEncoding gte (listEncoding gte) . unComp1
746 liftToEncoding gte (listEncoding gte) . unComp1
841− {-# INLINE gToJSON #-}
843--------------------------------------------------------------------------------
748--------------------------------------------------------------------------------
845−class SumToJSON enc arity f allNullary where
750+class SumToJSON arity f allNullary where
846− sumToJSON :: Options -> ToArgs enc arity a
751+ sumToJSON :: Options -> ToArgs Value arity a
847− -> f a -> Tagged allNullary enc
752+ -> f a -> Tagged allNullary Value
849−instance ( GetConName f
754+instance ( GetConName f
850− , FromString enc
755+ , TaggedObjectPairs arity f
851− , TaggedObject enc arity f
756+ , ObjectWithSingleFieldObj arity f
852− , SumToJSON' ObjectWithSingleField enc arity f
757+ , TwoElemArrayObj arity f
853− , SumToJSON' TwoElemArray enc arity f
758+ , UntaggedValueObj arity f
854− , SumToJSON' UntaggedValue enc arity f
855− ) => SumToJSON enc arity f True
759+ ) => SumToJSON arity f True where
857 sumToJSON opts targs
760 sumToJSON opts targs
858− | allNullaryToStringTag opts = Tagged . fromString
761+ | allNullaryToStringTag opts = Tagged . String . pack
859 . constructorTagModifier opts . getConName
762 . constructorTagModifier opts . getConName
860 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
763 | otherwise = Tagged . nonAllNullarySumToJSON opts targs
862−instance ( TaggedObject enc arity f
765+instance ( TwoElemArrayObj arity f
863− , SumToJSON' ObjectWithSingleField enc arity f
766+ , TaggedObjectPairs arity f
864− , SumToJSON' TwoElemArray enc arity f
767+ , ObjectWithSingleFieldObj arity f
865− , SumToJSON' UntaggedValue enc arity f
768+ , UntaggedValueObj arity f
866− ) => SumToJSON enc arity f False
769+ ) => SumToJSON arity f False where
868 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
770 sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
870−nonAllNullarySumToJSON :: ( TaggedObject enc arity f
772+nonAllNullarySumToJSON :: ( TwoElemArrayObj arity f
871− , SumToJSON' ObjectWithSingleField enc arity f
773+ , TaggedObjectPairs arity f
872− , SumToJSON' TwoElemArray enc arity f
774+ , ObjectWithSingleFieldObj arity f
873− , SumToJSON' UntaggedValue enc arity f
775+ , UntaggedValueObj arity f
874− ) => Options -> ToArgs enc arity a
776+ ) => Options -> ToArgs Value arity a
875− -> f a -> enc
777+ -> f a -> Value
876nonAllNullarySumToJSON opts targs =
778nonAllNullarySumToJSON opts targs =
877 case sumEncoding opts of
779 case sumEncoding opts of
879 TaggedObject{..} ->
780 TaggedObject{..} ->
880− taggedObject opts targs tagFieldName contentsFieldName
781+ object . taggedObjectPairs opts targs tagFieldName contentsFieldName
782+ ObjectWithSingleField -> Object . objectWithSingleFieldObj opts targs
783+ TwoElemArray -> Array . twoElemArrayObj opts targs
784+ UntaggedValue -> untaggedValueObj opts targs
882− ObjectWithSingleField ->
786+--------------------------------------------------------------------------------
883− (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884− . sumToJSON' opts targs
887− (unTagged :: Tagged TwoElemArray enc -> enc)
888− . sumToJSON' opts targs
890− UntaggedValue ->
788+class SumToEncoding arity f allNullary where
891− (unTagged :: Tagged UntaggedValue enc -> enc)
789+ sumToEncoding :: Options -> ToArgs Encoding arity a
892− . sumToJSON' opts targs
790+ -> f a -> Tagged allNullary Encoding
792+instance ( GetConName f
793+ , TaggedObjectEnc arity f
794+ , ObjectWithSingleFieldEnc arity f
795+ , TwoElemArrayEnc arity f
796+ , UntaggedValueEnc arity f
797+ ) => SumToEncoding arity f True where
798+ sumToEncoding opts targs
799+ | allNullaryToStringTag opts = Tagged . toEncoding .
800+ constructorTagModifier opts . getConName
801+ | otherwise = Tagged . nonAllNullarySumToEncoding opts targs
803+instance ( TwoElemArrayEnc arity f
804+ , TaggedObjectEnc arity f
805+ , ObjectWithSingleFieldEnc arity f
806+ , UntaggedValueEnc arity f
807+ ) => SumToEncoding arity f False where
808+ sumToEncoding opts targs = Tagged . nonAllNullarySumToEncoding opts targs
810+nonAllNullarySumToEncoding :: ( TwoElemArrayEnc arity f
811+ , TaggedObjectEnc arity f
812+ , ObjectWithSingleFieldEnc arity f
813+ , UntaggedValueEnc arity f
814+ ) => Options -> ToArgs Encoding arity a
816+nonAllNullarySumToEncoding opts targs =
817+ case sumEncoding opts of
819+ taggedObjectEnc opts targs tagFieldName contentsFieldName
820+ ObjectWithSingleField -> objectWithSingleFieldEnc opts targs
821+ TwoElemArray -> twoElemArrayEnc opts targs
822+ UntaggedValue -> untaggedValueEnc opts targs
894--------------------------------------------------------------------------------
824--------------------------------------------------------------------------------
896−class FromString enc where
826+class TaggedObjectPairs arity f where
897− fromString :: String -> enc
827+ taggedObjectPairs :: Options -> ToArgs Value arity a
831+instance ( TaggedObjectPairs arity a
832+ , TaggedObjectPairs arity b
833+ ) => TaggedObjectPairs arity (a :+: b) where
834+ taggedObjectPairs opts targs tagFieldName contentsFieldName (L1 x) =
835+ taggedObjectPairs opts targs tagFieldName contentsFieldName x
836+ taggedObjectPairs opts targs tagFieldName contentsFieldName (R1 x) =
837+ taggedObjectPairs opts targs tagFieldName contentsFieldName x
839+instance ( IsRecord a isRecord
840+ , TaggedObjectPairs' arity a isRecord
842+ ) => TaggedObjectPairs arity (C1 c a) where
843+ taggedObjectPairs opts targs tagFieldName contentsFieldName =
844+ (pack tagFieldName .= constructorTagModifier opts
845+ (conName (undefined :: t c a p)) :) .
846+ (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
847+ taggedObjectPairs' opts targs contentsFieldName . unM1
899−instance FromString Encoding where
849+class TaggedObjectPairs' arity f isRecord where
900− fromString = toEncoding
850+ taggedObjectPairs' :: Options -> ToArgs Value arity a
851+ -> String -> f a -> Tagged isRecord [Pair]
902−instance FromString Value where
853+instance OVERLAPPING_ TaggedObjectPairs' arity U1 False where
903− fromString = String . pack
854+ taggedObjectPairs' _ _ _ _ = Tagged []
905−--------------------------------------------------------------------------------
856+instance (RecordToPairs arity f) => TaggedObjectPairs' arity f True where
857+ taggedObjectPairs' opts targs _ =
858+ Tagged . toList . recordToPairs opts targs
907−class TaggedObject enc arity f where
860+instance (GToJSON arity f) => TaggedObjectPairs' arity f False where
908− taggedObject :: Options -> ToArgs enc arity a
861+ taggedObjectPairs' opts targs contentsFieldName =
909− -> String -> String
862+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts targs
912−instance ( TaggedObject enc arity a
864+--------------------------------------------------------------------------------
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
866+class TaggedObjectEnc arity f where
954− ) => TaggedObject' enc pairs arity f True
867+ taggedObjectEnc :: Options -> ToArgs Encoding arity a
955− where
868+ -> String -> String
956− taggedObject' opts targs _ = Tagged . recordToPairs opts targs
869+ -> f a -> Encoding
871+instance ( TaggedObjectEnc arity a
872+ , TaggedObjectEnc arity b
873+ ) => TaggedObjectEnc arity (a :+: b) where
874+ taggedObjectEnc opts targs tagFieldName contentsFieldName (L1 x) =
875+ taggedObjectEnc opts targs tagFieldName contentsFieldName x
876+ taggedObjectEnc opts targs tagFieldName contentsFieldName (R1 x) =
877+ taggedObjectEnc opts targs tagFieldName contentsFieldName x
879+instance ( IsRecord a isRecord
880+ , TaggedObjectEnc' arity a isRecord
882+ ) => TaggedObjectEnc arity (C1 c a) where
883+ taggedObjectEnc opts targs tagFieldName contentsFieldName v =
885+ (E.string tagFieldName ><
887+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) ><
888+ ((unTagged :: Tagged isRecord Encoding -> Encoding) .
889+ taggedObjectEnc' opts targs contentsFieldName . unM1 $ v)
891+class TaggedObjectEnc' arity f isRecord where
892+ taggedObjectEnc' :: Options -> ToArgs Encoding arity a
893+ -> String -> f a -> Tagged isRecord Encoding
895+instance OVERLAPPING_ TaggedObjectEnc' arity U1 False where
896+ taggedObjectEnc' _ _ _ _ = Tagged E.empty
898+instance (RecordToEncoding arity f) => TaggedObjectEnc' arity f True where
899+ taggedObjectEnc' opts targs _ = Tagged . (E.comma ><) . fst
900+ . recordToEncoding opts targs
902+instance (GToEncoding arity f) => TaggedObjectEnc' arity f False where
903+ taggedObjectEnc' opts targs contentsFieldName =
904+ Tagged . (\z -> E.comma >< toEncoding contentsFieldName >< E.colon >< z) .
905+ gToEncoding opts targs
958--------------------------------------------------------------------------------
907--------------------------------------------------------------------------------
@@ -968,38 +917,23 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
968instance (Constructor c) => GetConName (C1 c a) where
917instance (Constructor c) => GetConName (C1 c a) where
969 getConName = conName
918 getConName = conName
971−-- For genericToJSONKey
972−instance GetConName a => GetConName (D1 d a) where
973− getConName (M1 x) = getConName x
975--------------------------------------------------------------------------------
920--------------------------------------------------------------------------------
977−-- Reflection of SumEncoding variants
922+class TwoElemArrayObj arity f where
923+ twoElemArrayObj :: Options -> ToArgs Value arity a
924+ -> f a -> V.Vector Value
979−data ObjectWithSingleField
926+instance ( TwoElemArrayObj arity a
980−data TwoElemArray
927+ , TwoElemArrayObj arity b
981−data UntaggedValue
928+ ) => TwoElemArrayObj arity (a :+: b) where
929+ twoElemArrayObj opts targs (L1 x) = twoElemArrayObj opts targs x
930+ twoElemArrayObj opts targs (R1 x) = twoElemArrayObj opts targs x
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
990− , SumToJSON' s enc arity b
991− ) => SumToJSON' s enc arity (a :+: b)
993− sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994− sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
996−--------------------------------------------------------------------------------
998−instance ( GToJSON Value arity a
932+instance ( GToJSON arity a
999− , ConsToJSON Value arity a
933+ , ConsToJSON arity a
1000 , Constructor c
934 , Constructor c
1001− ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
935+ ) => TwoElemArrayObj arity (C1 c a) where
1002− sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
936+ twoElemArrayObj opts targs x = V.create $ do
1003 mv <- VM.unsafeNew 2
937 mv <- VM.unsafeNew 2
1004 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
938 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005 $ conName (undefined :: t c a p)
939 $ conName (undefined :: t c a p)
@@ -1008,121 +942,148 @@ instance ( GToJSON Value arity a
1009--------------------------------------------------------------------------------
943--------------------------------------------------------------------------------
1011−instance ( GToJSON Encoding arity a
945+class TwoElemArrayEnc arity f where
1012− , ConsToJSON Encoding arity a
946+ twoElemArrayEnc :: Options -> ToArgs Encoding arity a
949+instance ( TwoElemArrayEnc arity a
950+ , TwoElemArrayEnc arity b
951+ ) => TwoElemArrayEnc arity (a :+: b) where
952+ twoElemArrayEnc opts targs (L1 x) = twoElemArrayEnc opts targs x
953+ twoElemArrayEnc opts targs (R1 x) = twoElemArrayEnc opts targs x
955+instance ( GToEncoding arity a
956+ , ConsToEncoding arity a
1013 , Constructor c
957 , Constructor c
1014− ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
958+ ) => TwoElemArrayEnc arity (C1 c a) where
1015− where
959+ 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)))
960+ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
1018− , gToJSON opts targs x
961+ gToEncoding opts targs x
1021--------------------------------------------------------------------------------
963--------------------------------------------------------------------------------
1023−class ConsToJSON enc arity f where
965+class ConsToJSON arity f where
1024− consToJSON :: Options -> ToArgs enc arity a
966+ consToJSON :: Options -> ToArgs Value arity a
1025− -> f a -> enc
967+ -> f a -> Value
1027−class ConsToJSON' enc arity f isRecord where
969+class ConsToJSON' arity f isRecord where
1028− consToJSON' :: Options -> ToArgs enc arity a
970+ consToJSON' :: Options -> ToArgs Value arity a
971+ -> Bool -- ^ Are we a record with one field?
1029− -> f a -> Tagged isRecord enc
972+ -> f a -> Tagged isRecord Value
1031−instance ( IsRecord f isRecord
974+instance ( IsRecord f isRecord
1032− , ConsToJSON' enc arity f isRecord
975+ , ConsToJSON' arity f isRecord
1033− ) => ConsToJSON enc arity f
976+ ) => ConsToJSON arity f where
1035 consToJSON opts targs =
977 consToJSON opts targs =
1036− (unTagged :: Tagged isRecord enc -> enc)
978+ (unTagged :: Tagged isRecord Value -> Value)
1037− . consToJSON' opts targs
979+ . 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
981+instance (RecordToPairs arity f) => ConsToJSON' arity f True where
1046− consToJSON' opts targs
982+ consToJSON' opts targs isUn f = let
983+ vals = toList $ recordToPairs opts targs f
1047− | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
984+ in case (unwrapUnaryRecords opts,isUn,vals) of
1048− | otherwise = Tagged . fromPairs . recordToPairs opts targs
985+ (True,True,[(_,val)]) -> Tagged val
1049− {-# INLINE consToJSON' #-}
986+ _ -> 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
988+instance GToJSON arity f => ConsToJSON' arity f False where
1059− consToJSON' opts targs = Tagged . gToJSON opts targs
989+ consToJSON' opts targs _ = Tagged . gToJSON opts targs
1060− {-# INLINE consToJSON' #-}
1062--------------------------------------------------------------------------------
991--------------------------------------------------------------------------------
1064−class RecordToPairs enc pairs arity f where
993+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
994+ consToEncoding :: Options -> ToArgs Encoding arity a
1069− -> f a -> pairs
995+ -> f a -> Encoding
1071−instance ( Monoid pairs
997+class ConsToEncoding' arity f isRecord where
1072− , RecordToPairs enc pairs arity a
998+ consToEncoding' :: Options -> ToArgs Encoding arity a
1073− , RecordToPairs enc pairs arity b
999+ -> Bool -- ^ Are we a record with one field?
1074− ) => RecordToPairs enc pairs arity (a :*: b)
1000+ -> f a -> Tagged isRecord Encoding
1076− recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1002+instance ( IsRecord f isRecord
1077− pairsOf a `mappend` pairsOf b
1003+ , ConsToEncoding' arity f isRecord
1078− where
1004+ ) => ConsToEncoding arity f where
1079− pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1005+ consToEncoding opts targs =
1006+ (unTagged :: Tagged isRecord Encoding -> Encoding)
1007+ . consToEncoding' opts targs (isUnary (undefined :: f a))
1009+instance (RecordToEncoding arity f) => ConsToEncoding' arity f True where
1010+ consToEncoding' opts targs isUn x =
1011+ let (enc, mbVal) = recordToEncoding opts targs x
1012+ in case (unwrapUnaryRecords opts, isUn, mbVal) of
1013+ (True, True, Just val) -> Tagged val
1014+ _ -> Tagged $ E.wrapObject enc
1016+instance GToEncoding arity f => ConsToEncoding' arity f False where
1017+ consToEncoding' opts targs _ = Tagged . gToEncoding opts targs
1019+--------------------------------------------------------------------------------
1021+class RecordToPairs arity f where
1022+ recordToPairs :: Options -> ToArgs Value arity a
1023+ -> f a -> DList Pair
1025+instance ( RecordToPairs arity a
1026+ , RecordToPairs arity b
1027+ ) => RecordToPairs arity (a :*: b) where
1080− pairsOf = recordToPairs opts targs
1028+ recordToPairs opts targs (a :*: b) = recordToPairs opts targs a <>
1081− {-# INLINE recordToPairs #-}
1029+ 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)
1031+instance (Selector s, GToJSON arity a) => RecordToPairs arity (S1 s a) where
1088 recordToPairs = fieldToPair
1032 recordToPairs = fieldToPair
1089− {-# INLINE recordToPairs #-}
1033+
1091−instance INCOHERENT_
1092− ( Selector s
1034+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)))
1035+ RecordToPairs arity (S1 s (K1 i (Maybe a))) where
1098 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1036 recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099− , K1 Nothing <- k1 = mempty
1037+ , K1 Nothing <- k1 = DList.empty
1100 recordToPairs opts targs m1 = fieldToPair opts targs m1
1038 recordToPairs opts targs m1 = fieldToPair opts targs m1
1101− {-# INLINE recordToPairs #-}
1039+
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
1040+fieldToPair :: (Selector s, GToJSON arity a)
1117− , GToJSON enc arity a
1118− , KeyValuePair enc pairs)
1119− => Options -> ToArgs enc arity p
1041+ => Options -> ToArgs Value arity p
1120− -> S1 s a p -> pairs
1042+ -> S1 s a p -> DList Pair
1121−fieldToPair opts targs m1 =
1122− let key = fieldLabelModifier opts (selName m1)
1043+fieldToPair opts targs m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1123− value = gToJSON opts targs (unM1 m1)
1044+ , gToJSON opts targs (unM1 m1)
1124− in key `pair` value
1045+ )
1125−{-# INLINE fieldToPair #-}
1046+
1047+--------------------------------------------------------------------------------
1049+class RecordToEncoding arity f where
1050+ -- 1st element: whole thing
1051+ -- 2nd element: in case the record has only 1 field, just the value
1052+ -- of the field (without the key); 'Nothing' otherwise
1053+ recordToEncoding :: Options -> ToArgs Encoding arity a
1054+ -> f a -> (Encoding, Maybe Encoding)
1056+instance ( RecordToEncoding arity a
1057+ , RecordToEncoding arity b
1058+ ) => RecordToEncoding arity (a :*: b) where
1059+ recordToEncoding opts targs (a :*: b) | omitNothingFields opts =
1060+ (E.econcat $ intersperse E.comma $
1061+ filter (not . E.nullEncoding)
1062+ [ fst (recordToEncoding opts targs a)
1063+ , fst (recordToEncoding opts targs b) ]
1065+ recordToEncoding opts targs (a :*: b) =
1066+ (fst (recordToEncoding opts targs a) >< E.comma ><
1067+ fst (recordToEncoding opts targs b),
1071+instance (Selector s, GToEncoding arity a) => RecordToEncoding arity (S1 s a) where
1072+ recordToEncoding = fieldToEncoding
1074+instance OVERLAPPING_ (Selector s, ToJSON a) =>
1075+ RecordToEncoding arity (S1 s (K1 i (Maybe a))) where
1076+ recordToEncoding opts _ (M1 k1) | omitNothingFields opts
1077+ , K1 Nothing <- k1 = (E.empty, Nothing)
1078+ recordToEncoding opts targs m1 = fieldToEncoding opts targs m1
1080+fieldToEncoding :: (Selector s, GToEncoding arity a)
1081+ => Options -> ToArgs Encoding arity p
1082+ -> S1 s a p -> (Encoding, Maybe Encoding)
1083+fieldToEncoding opts targs m1 =
1084+ let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1085+ valueBuilder = gToEncoding opts targs (unM1 m1)
1086+ in (keyBuilder >< E.colon >< valueBuilder, Just valueBuilder)
1127--------------------------------------------------------------------------------
1088--------------------------------------------------------------------------------
@@ -1145,12 +1106,10 @@ instance ( WriteProduct arity a
1145 lenL = len `unsafeShiftR` 1
1106 lenL = len `unsafeShiftR` 1
1146 lenR = len - lenL
1107 lenR = len - lenL
1147 ixR = ix + lenL
1108 ixR = ix + lenL
1148− {-# INLINE writeProduct #-}
1150−instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1110+instance OVERLAPPABLE_ (GToJSON arity a) => WriteProduct arity a where
1151 writeProduct opts targs mv ix _ =
1111 writeProduct opts targs mv ix _ =
1152 VM.unsafeWrite mv ix . gToJSON opts targs
1112 VM.unsafeWrite mv ix . gToJSON opts targs
1153− {-# INLINE writeProduct #-}
1155--------------------------------------------------------------------------------
1114--------------------------------------------------------------------------------
@@ -1165,44 +1124,114 @@ instance ( EncodeProduct arity a
1165 E.econcat $ intersperse E.comma $
1124 E.econcat $ intersperse E.comma $
1166 filter (not . E.nullEncoding)
1125 filter (not . E.nullEncoding)
1167 [encodeProduct opts targs a, encodeProduct opts targs b]
1126 [encodeProduct opts targs a, encodeProduct opts targs b]
1168− encodeProduct opts targs (a :*: b) =
1127+ encodeProduct opts targs (a :*: b) = encodeProduct opts targs a >*<
1169− encodeProduct opts targs a >*<
1170− encodeProduct opts targs b
1128+ encodeProduct opts targs b
1171− {-# INLINE encodeProduct #-}
1173−instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1130+instance OVERLAPPABLE_ (GToEncoding arity a) => EncodeProduct arity a where
1174− encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1131+ encodeProduct opts targs a = E.retagEncoding $ gToEncoding opts targs a
1175− {-# INLINE encodeProduct #-}
1177--------------------------------------------------------------------------------
1133--------------------------------------------------------------------------------
1135+class ObjectWithSingleFieldObj arity f where
1136+ objectWithSingleFieldObj :: Options -> ToArgs Value arity a
1139+instance ( ObjectWithSingleFieldObj arity a
1140+ , ObjectWithSingleFieldObj arity b
1141+ ) => ObjectWithSingleFieldObj arity (a :+: b) where
1142+ objectWithSingleFieldObj opts targs (L1 x) =
1143+ objectWithSingleFieldObj opts targs x
1144+ objectWithSingleFieldObj opts targs (R1 x) =
1145+ objectWithSingleFieldObj opts targs x
1179−instance ( GToJSON enc arity a
1147+instance ( GToJSON arity a
1180− , ConsToJSON enc arity a
1148+ , ConsToJSON arity a
1181− , FromPairs enc pairs
1182− , KeyValuePair enc pairs
1183 , Constructor c
1149 , Constructor c
1184− ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1150+ ) => ObjectWithSingleFieldObj arity (C1 c a) where
1185− where
1151+ 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 $
1153+ typ = pack $ constructorTagModifier opts $
1190 conName (undefined :: t c a p)
1154 conName (undefined :: t c a p)
1192--------------------------------------------------------------------------------
1156--------------------------------------------------------------------------------
1158+class ObjectWithSingleFieldEnc arity f where
1159+ objectWithSingleFieldEnc :: Options -> ToArgs Encoding arity a
1162+instance ( ObjectWithSingleFieldEnc arity a
1163+ , ObjectWithSingleFieldEnc arity b
1164+ ) => ObjectWithSingleFieldEnc arity (a :+: b) where
1165+ objectWithSingleFieldEnc opts targs (L1 x) =
1166+ objectWithSingleFieldEnc opts targs x
1167+ objectWithSingleFieldEnc opts targs (R1 x) =
1168+ objectWithSingleFieldEnc opts targs x
1170+instance ( GToEncoding arity a
1171+ , ConsToEncoding arity a
1173+ ) => ObjectWithSingleFieldEnc arity (C1 c a) where
1174+ objectWithSingleFieldEnc opts targs v =
1177+ (constructorTagModifier opts
1178+ (conName (undefined :: t c a p))) ><
1180+ gToEncoding opts targs v ><
1183+--------------------------------------------------------------------------------
1185+class UntaggedValueObj arity f where
1186+ untaggedValueObj :: Options -> ToArgs Value arity a
1190+ ( UntaggedValueObj arity a
1191+ , UntaggedValueObj arity b
1192+ ) => UntaggedValueObj arity (a :+: b)
1194+ untaggedValueObj opts targs (L1 x) = untaggedValueObj opts targs x
1195+ untaggedValueObj opts targs (R1 x) = untaggedValueObj opts targs x
1194instance OVERLAPPABLE_
1197instance OVERLAPPABLE_
1195− ( ConsToJSON enc arity a
1199+ , ConsToJSON arity a
1196− ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1200+ ) => UntaggedValueObj arity (C1 c a) where
1201+ untaggedValueObj = gToJSON
1203+instance OVERLAPPING_
1205+ => UntaggedValueObj arity (C1 c U1)
1207+ untaggedValueObj opts _ _ = toJSON $
1208+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
1210+--------------------------------------------------------------------------------
1212+class UntaggedValueEnc arity f where
1213+ untaggedValueEnc :: Options -> ToArgs Encoding arity a
1216+ ( UntaggedValueEnc arity a
1217+ , UntaggedValueEnc arity b
1218+ ) => UntaggedValueEnc arity (a :+: b)
1220+ untaggedValueEnc opts targs (L1 x) = untaggedValueEnc opts targs x
1221+ untaggedValueEnc opts targs (R1 x) = untaggedValueEnc opts targs x
1223+instance OVERLAPPABLE_
1224+ ( GToEncoding arity a
1225+ , ConsToEncoding arity a
1226+ ) => UntaggedValueEnc arity (C1 c a)
1198− sumToJSON' opts targs = Tagged . gToJSON opts targs
1228+ untaggedValueEnc = gToEncoding
1200instance OVERLAPPING_
1230instance OVERLAPPING_
1201− ( Constructor c
1231+ ( Constructor c )
1202− , FromString enc
1232+ => UntaggedValueEnc arity (C1 c U1)
1203− ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1205− sumToJSON' opts _ _ = Tagged . fromString $
1234+ untaggedValueEnc opts _ _ = toEncoding $
1206 constructorTagModifier opts $ conName (undefined :: t c U1 p)
1235 constructorTagModifier opts $ conName (undefined :: t c U1 p)
1208-------------------------------------------------------------------------------
1237-------------------------------------------------------------------------------
@@ -1276,13 +1305,6 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1276 toEncoding = toEncoding2
1305 toEncoding = toEncoding2
1277 {-# INLINE toEncoding #-}
1306 {-# INLINE toEncoding #-}
1279−instance ToJSON Void where
1281− {-# INLINE toJSON #-}
1283− toEncoding = absurd
1284− {-# INLINE toEncoding #-}
1287instance ToJSON Bool where
1309instance ToJSON Bool where
1288 toJSON = Bool
1310 toJSON = Bool
@@ -1468,6 +1490,7 @@ instance ToJSONKey Int64 where
1468 toJSONKey = toJSONKeyTextEnc E.int64Text
1490 toJSONKey = toJSONKeyTextEnc E.int64Text
1469 {-# INLINE toJSONKey #-}
1491 {-# INLINE toJSONKey #-}
1471instance ToJSON Word where
1494instance ToJSON Word where
1472 toJSON = Number . fromIntegral
1495 toJSON = Number . fromIntegral
1473 {-# INLINE toJSON #-}
1496 {-# INLINE toJSON #-}
@@ -1527,12 +1550,6 @@ instance ToJSONKey Word64 where
1527 toJSONKey = toJSONKeyTextEnc E.word64Text
1550 toJSONKey = toJSONKeyTextEnc E.word64Text
1528 {-# INLINE toJSONKey #-}
1551 {-# 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
1554instance ToJSON Text where
1538 toJSON = String
1555 toJSON = String
@@ -1647,7 +1664,7 @@ instance (ToJSON a) => ToJSON (Identity a) where
1647 toEncodingList = liftToEncodingList toEncoding toEncodingList
1664 toEncodingList = liftToEncodingList toEncoding toEncodingList
1648 {-# INLINE toEncodingList #-}
1665 {-# INLINE toEncodingList #-}
1650−instance (ToJSONKey a) => ToJSONKey (Identity a) where
1667+instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1651 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1668 toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1669 toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
@@ -1796,11 +1813,13 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where
1796 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1813 ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1797 {-# INLINE liftToJSON #-}
1814 {-# INLINE liftToJSON #-}
1816+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
1799 liftToEncoding g _ = case toJSONKey of
1817 liftToEncoding g _ = case toJSONKey of
1800 ToJSONKeyText _ f -> dict f g M.foldrWithKey
1818 ToJSONKeyText _ f -> dict f g M.foldrWithKey
1801 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1819 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1821+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1803− pairEncoding f (a, b) = E.list id [f a, g b]
1822+ pairEncoding f (a, b) = tuple $ f a >*< g b
1804 {-# INLINE liftToEncoding #-}
1823 {-# INLINE liftToEncoding #-}
@@ -1838,17 +1857,6 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
1838 toEncoding = toEncoding1
1857 toEncoding = toEncoding1
1839 {-# INLINE toEncoding #-}
1858 {-# 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-------------------------------------------------------------------------------
1861-------------------------------------------------------------------------------
1854-- vector
1862-- vector
@@ -1862,8 +1870,6 @@ instance ToJSON1 Vector where
1862 {-# INLINE liftToEncoding #-}
1870 {-# INLINE liftToEncoding #-}
1864instance (ToJSON a) => ToJSON (Vector a) where
1872instance (ToJSON a) => ToJSON (Vector a) where
1865− {-# SPECIALIZE instance ToJSON Array #-}
1867 toJSON = toJSON1
1873 toJSON = toJSON1
1868 {-# INLINE toJSON #-}
1874 {-# INLINE toJSON #-}
@@ -1931,12 +1937,11 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1931 ToJSONKeyText _ f -> dict f g H.foldrWithKey
1937 ToJSONKeyText _ f -> dict f g H.foldrWithKey
1932 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1938 ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1940+ -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1934− pairEncoding f (a, b) = E.list id [f a, g b]
1941+ pairEncoding f (a, b) = tuple $ f a >*< g b
1935 {-# INLINE liftToEncoding #-}
1942 {-# INLINE liftToEncoding #-}
1937instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1944instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938− {-# SPECIALIZE instance ToJSON Object #-}
1940 toJSON = toJSON1
1945 toJSON = toJSON1
1941 {-# INLINE toJSON #-}
1946 {-# INLINE toJSON #-}
@@ -1966,32 +1971,6 @@ dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1966formatMillis :: (FormatTime t) => t -> String
1971formatMillis :: (FormatTime t) => t -> String
1967formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1972formatMillis = 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-------------------------------------------------------------------------------
1974-------------------------------------------------------------------------------
1997-------------------------------------------------------------------------------
1976-------------------------------------------------------------------------------
@@ -2040,11 +2019,10 @@ stringEncoding :: Encoding' Text -> Value
2040stringEncoding = String
2019stringEncoding = String
2041 . T.dropAround (== '"')
2020 . T.dropAround (== '"')
2042 . T.decodeLatin1
2021 . T.decodeLatin1
2043− . L.toStrict
2022+ . lazyToStrictByteString
2044 . E.encodingToLazyByteString
2023 . E.encodingToLazyByteString
2045{-# INLINE stringEncoding #-}
2024{-# INLINE stringEncoding #-}
2048instance ToJSON NominalDiffTime where
2026instance ToJSON NominalDiffTime where
2049 toJSON = Number . realToFrac
2027 toJSON = Number . realToFrac
2050 {-# INLINE toJSON #-}
2028 {-# INLINE toJSON #-}
@@ -2052,100 +2030,18 @@ instance ToJSON NominalDiffTime where
2052 toEncoding = E.scientific . realToFrac
2030 toEncoding = E.scientific . realToFrac
2053 {-# INLINE toEncoding #-}
2031 {-# 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-------------------------------------------------------------------------------
2033-------------------------------------------------------------------------------
2108-- base Monoid/Semigroup
2034-- base Monoid/Semigroup
2109-------------------------------------------------------------------------------
2035-------------------------------------------------------------------------------
2111−instance ToJSON1 Monoid.Dual where
2037+instance ToJSON1 Dual where
2112− liftToJSON t _ = t . Monoid.getDual
2038+ 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 #-}
2039 {-# INLINE liftToJSON #-}
2145− liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2041+ liftToEncoding t _ = t . getDual
2146 {-# INLINE liftToEncoding #-}
2042 {-# INLINE liftToEncoding #-}
2148−instance ToJSON a => ToJSON (Monoid.Last a) where
2044+instance ToJSON a => ToJSON (Dual a) where
2149 toJSON = toJSON1
2045 toJSON = toJSON1
2150 {-# INLINE toJSON #-}
2046 {-# INLINE toJSON #-}
@@ -2153,14 +2049,14 @@ instance ToJSON a => ToJSON (Monoid.Last a) where
2153 {-# INLINE toEncoding #-}
2049 {-# INLINE toEncoding #-}
2156−instance ToJSON1 Semigroup.Min where
2052+instance ToJSON1 First where
2157− liftToJSON t _ (Semigroup.Min x) = t x
2053+ liftToJSON t to' = liftToJSON t to' . getFirst
2158 {-# INLINE liftToJSON #-}
2054 {-# INLINE liftToJSON #-}
2160− liftToEncoding t _ (Semigroup.Min x) = t x
2056+ liftToEncoding t to' = liftToEncoding t to' . getFirst
2161 {-# INLINE liftToEncoding #-}
2057 {-# INLINE liftToEncoding #-}
2163−instance ToJSON a => ToJSON (Semigroup.Min a) where
2059+instance ToJSON a => ToJSON (First a) where
2164 toJSON = toJSON1
2060 toJSON = toJSON1
2165 {-# INLINE toJSON #-}
2061 {-# INLINE toJSON #-}
@@ -2168,73 +2064,14 @@ instance ToJSON a => ToJSON (Semigroup.Min a) where
2168 {-# INLINE toEncoding #-}
2064 {-# INLINE toEncoding #-}
2171−instance ToJSON1 Semigroup.Max where
2067+instance ToJSON1 Last where
2172− liftToJSON t _ (Semigroup.Max x) = t x
2068+ liftToJSON t to' = liftToJSON t to' . getLast
2173 {-# INLINE liftToJSON #-}
2069 {-# INLINE liftToJSON #-}
2175− liftToEncoding t _ (Semigroup.Max x) = t x
2071+ liftToEncoding t to' = liftToEncoding t to' . getLast
2176 {-# INLINE liftToEncoding #-}
2072 {-# INLINE liftToEncoding #-}
2178−instance ToJSON a => ToJSON (Semigroup.Max a) where
2074+instance ToJSON a => ToJSON (Last a) where
2180− {-# INLINE toJSON #-}
2182− toEncoding = toEncoding1
2183− {-# INLINE toEncoding #-}
2185−instance ToJSON1 Semigroup.First where
2186− liftToJSON t _ (Semigroup.First x) = t x
2187− {-# INLINE liftToJSON #-}
2189− liftToEncoding t _ (Semigroup.First x) = t x
2190− {-# INLINE liftToEncoding #-}
2192−instance ToJSON a => ToJSON (Semigroup.First a) where
2194− {-# INLINE toJSON #-}
2196− toEncoding = toEncoding1
2197− {-# INLINE toEncoding #-}
2200−instance ToJSON1 Semigroup.Last where
2201− liftToJSON t _ (Semigroup.Last x) = t x
2202− {-# INLINE liftToJSON #-}
2204− liftToEncoding t _ (Semigroup.Last x) = t x
2205− {-# INLINE liftToEncoding #-}
2207−instance ToJSON a => ToJSON (Semigroup.Last a) where
2209− {-# INLINE toJSON #-}
2211− toEncoding = toEncoding1
2212− {-# INLINE toEncoding #-}
2215−instance ToJSON1 Semigroup.WrappedMonoid where
2216− liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217− {-# INLINE liftToJSON #-}
2219− liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220− {-# INLINE liftToEncoding #-}
2222−instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2224− {-# INLINE toJSON #-}
2226− toEncoding = toEncoding1
2227− {-# INLINE toEncoding #-}
2230−instance ToJSON1 Semigroup.Option where
2231− liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232− {-# INLINE liftToJSON #-}
2234− liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235− {-# INLINE liftToEncoding #-}
2237−instance ToJSON a => ToJSON (Semigroup.Option a) where
2238 toJSON = toJSON1
2075 toJSON = toJSON1
2239 {-# INLINE toJSON #-}
2076 {-# INLINE toJSON #-}
@@ -2245,13 +2082,6 @@ instance ToJSON a => ToJSON (Semigroup.Option a) where
2245-- tagged
2082-- tagged
2246-------------------------------------------------------------------------------
2083-------------------------------------------------------------------------------
2248−instance ToJSON1 Proxy where
2249− liftToJSON _ _ _ = Null
2250− {-# INLINE liftToJSON #-}
2252− liftToEncoding _ _ _ = E.null_
2253− {-# INLINE liftToEncoding #-}
2255instance ToJSON (Proxy a) where
2085instance ToJSON (Proxy a) where
2256 toJSON _ = Null
2086 toJSON _ = Null
2257 {-# INLINE toJSON #-}
2087 {-# INLINE toJSON #-}
@@ -2260,13 +2090,6 @@ instance ToJSON (Proxy a) where
2260 {-# INLINE toEncoding #-}
2090 {-# 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
2093instance ToJSON1 (Tagged a) where
2271 liftToJSON t _ (Tagged x) = t x
2094 liftToJSON t _ (Tagged x) = t x
2272 {-# INLINE liftToJSON #-}
2095 {-# INLINE liftToJSON #-}
@@ -2281,6 +2104,7 @@ instance ToJSON b => ToJSON (Tagged a b) where
2281 toEncoding = toEncoding1
2104 toEncoding = toEncoding1
2282 {-# INLINE toEncoding #-}
2105 {-# INLINE toEncoding #-}
2284instance ToJSONKey b => ToJSONKey (Tagged a b) where
2108instance ToJSONKey b => ToJSONKey (Tagged a b) where
2285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2109 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2110 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -2301,7 +2125,7 @@ instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2301 toJSONKey = toJSONKeyList
2125 toJSONKey = toJSONKeyList
2303-------------------------------------------------------------------------------
2127-------------------------------------------------------------------------------
2304−-- Tuple instances
2128+-- Tuple instances, see tuple-instances-to.hs
2305-------------------------------------------------------------------------------
2129-------------------------------------------------------------------------------
2307instance ToJSON2 (,) where
2131instance ToJSON2 (,) where
@@ -2312,7 +2136,9 @@ instance ToJSON2 (,) where
2312 return mv
2136 return mv
2313 {-# INLINE liftToJSON2 #-}
2137 {-# INLINE liftToJSON2 #-}
2315− liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2139+ liftToEncoding2 toA _ toB _ (a, b) = tuple $
2316 {-# INLINE liftToEncoding2 #-}
2142 {-# INLINE liftToEncoding2 #-}
2318instance (ToJSON a) => ToJSON1 ((,) a) where
2144instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -2336,11 +2162,10 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
2336 return mv
2162 return mv
2337 {-# INLINE liftToJSON2 #-}
2163 {-# INLINE liftToJSON2 #-}
2339− liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2165+ liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2340− [ toEncoding a
2166+ toEncoding a >*<
2341− , toB b
2167+ toB b >*<
2344 {-# INLINE liftToEncoding2 #-}
2169 {-# INLINE liftToEncoding2 #-}
2346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
2171instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -2365,12 +2190,11 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
2365 return mv
2190 return mv
2366 {-# INLINE liftToJSON2 #-}
2191 {-# INLINE liftToJSON2 #-}
2368− liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2193+ liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2369− [ toEncoding a
2194+ toEncoding a >*<
2370− , toEncoding b
2195+ toEncoding b >*<
2371− , toC c
2196+ toC c >*<
2374 {-# INLINE liftToEncoding2 #-}
2198 {-# INLINE liftToEncoding2 #-}
2376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
2200instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -2396,13 +2220,12 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
2396 return mv
2220 return mv
2397 {-# INLINE liftToJSON2 #-}
2221 {-# INLINE liftToJSON2 #-}
2399− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2223+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2400− [ toEncoding a
2224+ toEncoding a >*<
2401− , toEncoding b
2225+ toEncoding b >*<
2402− , toEncoding c
2226+ toEncoding c >*<
2403− , toD d
2227+ toD d >*<
2406 {-# INLINE liftToEncoding2 #-}
2229 {-# INLINE liftToEncoding2 #-}
2408instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
2231instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -2429,14 +2252,13 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
2429 return mv
2252 return mv
2430 {-# INLINE liftToJSON2 #-}
2253 {-# INLINE liftToJSON2 #-}
2432− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2255+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2433− [ toEncoding a
2256+ toEncoding a >*<
2434− , toEncoding b
2257+ toEncoding b >*<
2435− , toEncoding c
2258+ toEncoding c >*<
2436− , toEncoding d
2259+ toEncoding d >*<
2437− , toE e
2260+ toE e >*<
2440 {-# INLINE liftToEncoding2 #-}
2262 {-# INLINE liftToEncoding2 #-}
2442instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
2264instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -2464,15 +2286,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
2464 return mv
2286 return mv
2465 {-# INLINE liftToJSON2 #-}
2287 {-# INLINE liftToJSON2 #-}
2467− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2289+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2468− [ toEncoding a
2290+ toEncoding a >*<
2469− , toEncoding b
2291+ toEncoding b >*<
2470− , toEncoding c
2292+ toEncoding c >*<
2471− , toEncoding d
2293+ toEncoding d >*<
2472− , toEncoding e
2294+ toEncoding e >*<
2473− , toF f
2295+ toF f >*<
2476 {-# INLINE liftToEncoding2 #-}
2297 {-# INLINE liftToEncoding2 #-}
2478instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
2299instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -2501,16 +2322,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
2501 return mv
2322 return mv
2502 {-# INLINE liftToJSON2 #-}
2323 {-# INLINE liftToJSON2 #-}
2504− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2325+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2505− [ toEncoding a
2326+ toEncoding a >*<
2506− , toEncoding b
2327+ toEncoding b >*<
2507− , toEncoding c
2328+ toEncoding c >*<
2508− , toEncoding d
2329+ toEncoding d >*<
2509− , toEncoding e
2330+ toEncoding e >*<
2510− , toEncoding f
2331+ toEncoding f >*<
2511− , toG g
2332+ toG g >*<
2514 {-# INLINE liftToEncoding2 #-}
2334 {-# 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
2336instance (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 +2360,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
2540 return mv
2360 return mv
2541 {-# INLINE liftToJSON2 #-}
2361 {-# INLINE liftToJSON2 #-}
2543− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2363+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2544− [ toEncoding a
2364+ toEncoding a >*<
2545− , toEncoding b
2365+ toEncoding b >*<
2546− , toEncoding c
2366+ toEncoding c >*<
2547− , toEncoding d
2367+ toEncoding d >*<
2548− , toEncoding e
2368+ toEncoding e >*<
2549− , toEncoding f
2369+ toEncoding f >*<
2550− , toEncoding g
2370+ toEncoding g >*<
2551− , toH h
2371+ toH h >*<
2554 {-# INLINE liftToEncoding2 #-}
2373 {-# 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
2375instance (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 +2400,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2581 return mv
2400 return mv
2582 {-# INLINE liftToJSON2 #-}
2401 {-# INLINE liftToJSON2 #-}
2584− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2403+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2585− [ toEncoding a
2404+ toEncoding a >*<
2586− , toEncoding b
2405+ toEncoding b >*<
2587− , toEncoding c
2406+ toEncoding c >*<
2588− , toEncoding d
2407+ toEncoding d >*<
2589− , toEncoding e
2408+ toEncoding e >*<
2590− , toEncoding f
2409+ toEncoding f >*<
2591− , toEncoding g
2410+ toEncoding g >*<
2592− , toEncoding h
2411+ toEncoding h >*<
2593− , toI i
2412+ toI i >*<
2596 {-# INLINE liftToEncoding2 #-}
2414 {-# 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
2416instance (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 +2442,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2624 return mv
2442 return mv
2625 {-# INLINE liftToJSON2 #-}
2443 {-# INLINE liftToJSON2 #-}
2627− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2445+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2628− [ toEncoding a
2446+ toEncoding a >*<
2629− , toEncoding b
2447+ toEncoding b >*<
2630− , toEncoding c
2448+ toEncoding c >*<
2631− , toEncoding d
2449+ toEncoding d >*<
2632− , toEncoding e
2450+ toEncoding e >*<
2633− , toEncoding f
2451+ toEncoding f >*<
2634− , toEncoding g
2452+ toEncoding g >*<
2635− , toEncoding h
2453+ toEncoding h >*<
2636− , toEncoding i
2454+ toEncoding i >*<
2637− , toJ j
2455+ toJ j >*<
2640 {-# INLINE liftToEncoding2 #-}
2457 {-# 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
2459instance (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 +2486,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2669 return mv
2486 return mv
2670 {-# INLINE liftToJSON2 #-}
2487 {-# INLINE liftToJSON2 #-}
2672− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2489+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2673− [ toEncoding a
2490+ toEncoding a >*<
2674− , toEncoding b
2491+ toEncoding b >*<
2675− , toEncoding c
2492+ toEncoding c >*<
2676− , toEncoding d
2493+ toEncoding d >*<
2677− , toEncoding e
2494+ toEncoding e >*<
2678− , toEncoding f
2495+ toEncoding f >*<
2679− , toEncoding g
2496+ toEncoding g >*<
2680− , toEncoding h
2497+ toEncoding h >*<
2681− , toEncoding i
2498+ toEncoding i >*<
2682− , toEncoding j
2499+ toEncoding j >*<
2683− , toK k
2500+ toK k >*<
2686 {-# INLINE liftToEncoding2 #-}
2502 {-# 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
2504instance (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 +2532,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2716 return mv
2532 return mv
2717 {-# INLINE liftToJSON2 #-}
2533 {-# INLINE liftToJSON2 #-}
2719− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2535+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2720− [ toEncoding a
2536+ toEncoding a >*<
2721− , toEncoding b
2537+ toEncoding b >*<
2722− , toEncoding c
2538+ toEncoding c >*<
2723− , toEncoding d
2539+ toEncoding d >*<
2724− , toEncoding e
2540+ toEncoding e >*<
2725− , toEncoding f
2541+ toEncoding f >*<
2726− , toEncoding g
2542+ toEncoding g >*<
2727− , toEncoding h
2543+ toEncoding h >*<
2728− , toEncoding i
2544+ toEncoding i >*<
2729− , toEncoding j
2545+ toEncoding j >*<
2730− , toEncoding k
2546+ toEncoding k >*<
2731− , toL l
2547+ toL l >*<
2734 {-# INLINE liftToEncoding2 #-}
2549 {-# 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
2551instance (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 +2580,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2765 return mv
2580 return mv
2766 {-# INLINE liftToJSON2 #-}
2581 {-# INLINE liftToJSON2 #-}
2768− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2583+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2769− [ toEncoding a
2584+ toEncoding a >*<
2770− , toEncoding b
2585+ toEncoding b >*<
2771− , toEncoding c
2586+ toEncoding c >*<
2772− , toEncoding d
2587+ toEncoding d >*<
2773− , toEncoding e
2588+ toEncoding e >*<
2774− , toEncoding f
2589+ toEncoding f >*<
2775− , toEncoding g
2590+ toEncoding g >*<
2776− , toEncoding h
2591+ toEncoding h >*<
2777− , toEncoding i
2592+ toEncoding i >*<
2778− , toEncoding j
2593+ toEncoding j >*<
2779− , toEncoding k
2594+ toEncoding k >*<
2780− , toEncoding l
2595+ toEncoding l >*<
2781− , toM m
2596+ toM m >*<
2784 {-# INLINE liftToEncoding2 #-}
2598 {-# 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
2600instance (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 +2630,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2816 return mv
2630 return mv
2817 {-# INLINE liftToJSON2 #-}
2631 {-# INLINE liftToJSON2 #-}
2819− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2633+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2820− [ toEncoding a
2634+ toEncoding a >*<
2821− , toEncoding b
2635+ toEncoding b >*<
2822− , toEncoding c
2636+ toEncoding c >*<
2823− , toEncoding d
2637+ toEncoding d >*<
2824− , toEncoding e
2638+ toEncoding e >*<
2825− , toEncoding f
2639+ toEncoding f >*<
2826− , toEncoding g
2640+ toEncoding g >*<
2827− , toEncoding h
2641+ toEncoding h >*<
2828− , toEncoding i
2642+ toEncoding i >*<
2829− , toEncoding j
2643+ toEncoding j >*<
2830− , toEncoding k
2644+ toEncoding k >*<
2831− , toEncoding l
2645+ toEncoding l >*<
2832− , toEncoding m
2646+ toEncoding m >*<
2833− , toN n
2647+ toN n >*<
2836 {-# INLINE liftToEncoding2 #-}
2649 {-# 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
2651instance (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 +2660,27 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2847 toEncoding = toEncoding2
2660 toEncoding = toEncoding2
2848 {-# INLINE toEncoding #-}
2661 {-# INLINE toEncoding #-}
2850−--------------------------------------------------------------------------------
2663+-------------------------------------------------------------------------------
2851−
2664+-- pre-bytestring-0.10 compatibility
2852−-- | Wrap a list of pairs as an object.
2665+-------------------------------------------------------------------------------
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
2667+{-# INLINE lazyToStrictByteString #-}
2863−-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2668+lazyToStrictByteString :: L.ByteString -> S.ByteString
2864−-- so it can be readily concatenated.
2669+#if MIN_VERSION_bytestring(0,10,0)
2865−class Monoid kv => KeyValuePair v kv where
2670+lazyToStrictByteString = L.toStrict
2866− pair :: String -> v -> kv
2671+#else
2672+lazyToStrictByteString = packChunks
2868−instance (v ~ Value) => KeyValuePair v (DList Pair) where
2674+-- 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
2676+-- | Pack the chunks of a lazy bytestring into a single strict bytestring.
2872− pair = E.pairStr
2677+packChunks :: L.ByteString -> S.ByteString
2679+ S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
2681+ copyChunks !L.Empty !_pf = return ()
2682+ copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf = do
2683+ withForeignPtr fpbuf $ \pbuf ->
2684+ copyBytes pf (pbuf `plusPtr` o) l
2685+ copyChunks lbs' (pf `plusPtr` l)