@@ -1,29 +1,27 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DefaultSignatures #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE EmptyDataDecls #-}
4−{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
6−{-# LANGUAGE GADTs #-}
7+{-# LANGUAGE GADTs #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9−{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PatternGuards #-}
10+{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE RecordWildCards #-}
12+{-# LANGUAGE RecordWildCards #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13+{-# LANGUAGE ScopedTypeVariables #-}
13−{-# LANGUAGE TypeOperators #-}
14+{-# LANGUAGE TypeOperators #-}
14−{-# LANGUAGE TypeSynonymInstances #-}
15−{-# LANGUAGE UndecidableInstances #-}
15+{-# LANGUAGE UndecidableInstances #-}
17−#if __GLASGOW_HASKELL__ >= 706
18−{-# LANGUAGE PolyKinds #-}
21#include "overlapping-compat.h"
17#include "overlapping-compat.h"
18+#include "incoherent-compat.h"
23-- TODO: Drop this when we remove support for Data.Attoparsec.Number
20-- TODO: Drop this when we remove support for Data.Attoparsec.Number
24{-# OPTIONS_GHC -fno-warn-deprecations #-}
21{-# OPTIONS_GHC -fno-warn-deprecations #-}
26−module Data.Aeson.Types.ToJSON (
23+module Data.Aeson.Types.ToJSON
27 -- * Core JSON classes
25 -- * Core JSON classes
28 ToJSON(..)
26 ToJSON(..)
29 -- * Liftings to unary and binary type constructors
27 -- * Liftings to unary and binary type constructors
@@ -35,95 +33,115 @@ module Data.Aeson.Types.ToJSON (
35 , toEncoding2
33 , toEncoding2
36 -- * Generic JSON classes
34 -- * Generic JSON classes
37 , GToJSON(..)
35 , GToJSON(..)
38− , GToEncoding(..)
36+ , ToArgs(..)
39 , genericToJSON
37 , genericToJSON
40 , genericToEncoding
38 , genericToEncoding
40+ , genericLiftToEncoding
41 -- * Classes and types for map keys
41 -- * Classes and types for map keys
42 , ToJSONKey(..)
42 , ToJSONKey(..)
43 , ToJSONKeyFunction(..)
43 , ToJSONKeyFunction(..)
44 , contramapToJSONKeyFunction
45 , contramapToJSONKeyFunction
45 -- * Object key-value pairs
50 -- * Object key-value pairs
46 , KeyValue(..)
51 , KeyValue(..)
47 -- * Functions needed for documentation
54 -- * Functions needed for documentation
48 -- * Encoding functions
55 -- * Encoding functions
49 , listEncoding
56 , listEncoding
50 , listValue
57 , listValue
54import Prelude.Compat
60import Prelude.Compat
62+import Control.Applicative (Const(..))
63+import Control.Monad.ST (ST)
56−import Data.Aeson.Encoding.Internal (Encoding (..), Series, dict, emptyArray_,
64+import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
57− tuple, (>*<))
65+import Data.Aeson.Encoding.Internal ((>*<))
58−import Data.Aeson.Functions (mapHashKeyVal, mapKeyVal)
66+import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
59−import Data.Aeson.Types.Generic
67+import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
60import Data.Aeson.Types.Internal
68import Data.Aeson.Types.Internal
62−import qualified Data.Aeson.Encode.Builder as EB
63−import qualified Data.Aeson.Encoding.Internal as E
65−import Control.Applicative (Const (..))
66−import Control.Monad.ST (ST)
67−import Data.Attoparsec.Number (Number (..))
69+import Data.Attoparsec.Number (Number(..))
68−import Data.Bits (unsafeShiftR)
70+import Data.Bits (unsafeShiftR)
69−import Data.DList (DList)
71+import Data.DList (DList)
70−import Data.Fixed (Fixed, HasResolution)
72+import Data.Fixed (Fixed, HasResolution, Nano)
71−import Data.Foldable (toList)
73+import Data.Foldable (toList)
72−import Data.Functor.Identity (Identity (..))
74+import Data.Functor.Compose (Compose(..))
75+import Data.Functor.Contravariant (Contravariant (..))
76+import Data.Functor.Identity (Identity(..))
77+import Data.Functor.Product (Product(..))
78+import Data.Functor.Sum (Sum(..))
73−import Data.Int (Int16, Int32, Int64, Int8)
79+import Data.Int (Int16, Int32, Int64, Int8)
74−import Data.List (intersperse)
80+import Data.List (intersperse)
75−import Data.List.NonEmpty (NonEmpty (..))
81+import Data.List.NonEmpty (NonEmpty(..))
76−import Data.Monoid (Dual (..), First (..), Last (..), (<>))
82+import Data.Semigroup ((<>))
77−import Data.Proxy (Proxy (..))
83+import Data.Proxy (Proxy(..))
78−import Data.Ratio (Ratio, denominator, numerator)
84+import Data.Ratio (Ratio, denominator, numerator)
79−import Data.Scientific (Scientific)
85+import Data.Scientific (Scientific)
80−import Data.Tagged (Tagged (..))
86+import Data.Tagged (Tagged(..))
81−import Data.Text (Text, pack)
87+import Data.Text (Text, pack)
82−import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay,
88+import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
83− UTCTime, ZonedTime)
89+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
90+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
91+import Data.Time.Clock.System.Compat (SystemTime (..))
84−import Data.Time.Format (FormatTime, formatTime)
92+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
85−import Data.Time.Locale.Compat (defaultTimeLocale)
86−import Data.Vector (Vector)
93+import Data.Vector (Vector)
87−import Data.Version (Version, showVersion)
94+import Data.Version (Version, showVersion)
95+import Data.Void (Void, absurd)
88−import Data.Word (Word16, Word32, Word64, Word8)
96+import Data.Word (Word16, Word32, Word64, Word8)
89−import Foreign.Storable (Storable)
97+import Foreign.Storable (Storable)
98+import Foreign.C.Types (CTime (..))
90import GHC.Generics
99import GHC.Generics
91−import Numeric.Natural (Natural)
100+import Numeric.Natural (Natural)
92−
101+import qualified Data.Aeson.Encoding as E
93−import qualified Data.ByteString.Builder as B
102+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
94−import qualified Data.ByteString.Lazy as L
103+import qualified Data.ByteString.Lazy as L
95−import qualified Data.DList as DList
104+import qualified Data.DList as DList
96−import qualified Data.HashMap.Strict as H
105+import qualified Data.HashMap.Strict as H
97−import qualified Data.HashSet as HashSet
106+import qualified Data.HashSet as HashSet
98−import qualified Data.IntMap as IntMap
107+import qualified Data.IntMap as IntMap
99−import qualified Data.IntSet as IntSet
108+import qualified Data.IntSet as IntSet
100−import qualified Data.List.NonEmpty as NE
109+import qualified Data.List.NonEmpty as NE
101−import qualified Data.Map as M
110+import qualified Data.Map as M
111+import qualified Data.Monoid as Monoid
102−import qualified Data.Scientific as Scientific
112+import qualified Data.Scientific as Scientific
103−import qualified Data.Sequence as Seq
113+import qualified Data.Semigroup as Semigroup
114+import qualified Data.Sequence as Seq
104−import qualified Data.Set as Set
115+import qualified Data.Set as Set
105−import qualified Data.Text as T
116+import qualified Data.Text as T
106−import qualified Data.Text.Encoding as T
117+import qualified Data.Text.Encoding as T
107−import qualified Data.Text.Lazy as LT
118+import qualified Data.Text.Lazy as LT
108−import qualified Data.Text.Lazy.Builder as LTB
119+import qualified Data.Tree as Tree
109−import qualified Data.Text.Lazy.Builder.Int as LTBI
120+import qualified Data.UUID.Types as UUID
110−import qualified Data.Tree as Tree
111−import qualified Data.Vector as V
121+import qualified Data.Vector as V
112−import qualified Data.Vector.Generic as VG
122+import qualified Data.Vector.Generic as VG
113−import qualified Data.Vector.Mutable as VM
123+import qualified Data.Vector.Mutable as VM
114−import qualified Data.Vector.Primitive as VP
124+import qualified Data.Vector.Primitive as VP
115−import qualified Data.Vector.Storable as VS
125+import qualified Data.Vector.Storable as VS
116−import qualified Data.Vector.Unboxed as VU
126+import qualified Data.Vector.Unboxed as VU
118−builder :: ToJSON a => a -> B.Builder
128+import qualified Data.Aeson.Encoding.Builder as EB
119−builder = fromEncoding . toEncoding
129+import qualified Data.ByteString.Builder as B
131+import qualified GHC.Exts as Exts
132+import qualified Data.Primitive.Array as PM
133+import qualified Data.Primitive.SmallArray as PM
134+import qualified Data.Primitive.Types as PM
136+#if MIN_VERSION_primitive(0,6,4)
137+#if !MIN_VERSION_primitive(0,7,0)
138+import qualified Data.Primitive.UnliftedArray as PM
140+import qualified Data.Primitive.PrimArray as PM
121toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
143toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
122−toJSONPair keySerialiser valSerializer (a, b) = Array $ V.create $ do
144+toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
123− mv <- VM.unsafeNew 2
124− VM.unsafeWrite mv 0 (keySerialiser a)
125− VM.unsafeWrite mv 1 (valSerializer b)
127{-# INLINE toJSONPair #-}
145{-# INLINE toJSONPair #-}
129realFloatToJSON :: RealFloat a => a -> Value
147realFloatToJSON :: RealFloat a => a -> Value
@@ -132,41 +150,59 @@ realFloatToJSON d
132 | otherwise = Number $ Scientific.fromFloatDigits d
150 | otherwise = Number $ Scientific.fromFloatDigits d
133{-# INLINE realFloatToJSON #-}
151{-# INLINE realFloatToJSON #-}
135−realFloatToEncoding :: RealFloat a => a -> Encoding
136−realFloatToEncoding d
137− | isNaN d || isInfinite d = Encoding EB.null_
138− | otherwise = toEncoding (Scientific.fromFloatDigits d)
139−{-# INLINE realFloatToEncoding #-}
140-------------------------------------------------------------------------------
153-------------------------------------------------------------------------------
141-- Generics
154-- Generics
142-------------------------------------------------------------------------------
155-------------------------------------------------------------------------------
144−-- | Class of generic representation types ('Rep') that can be converted to
157+-- | Class of generic representation types that can be converted to
146−class GToJSON f where
159+class GToJSON enc arity f where
147 -- | This method (applied to 'defaultOptions') is used as the
160 -- | This method (applied to 'defaultOptions') is used as the
148− -- default generic implementation of 'toJSON'.
161+ -- default generic implementation of 'toJSON'
162+ -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
163+ -- and 'liftToJSON' (if the @arity@ is 'One').
165+ -- It also provides a generic implementation of 'toEncoding'
166+ -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
167+ -- and 'liftToEncoding' (if the @arity@ is 'One').
149− gToJSON :: Options -> f a -> Value
168+ gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
151−-- | Class of generic representation types ('Rep') that can be converted to
170+-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
152−-- a JSON 'Encoding'.
171+-- function arguments that encode occurrences of the type parameter (for
153−class GToEncoding f where
172+-- 'ToJSON1').
154− -- | This method (applied to 'defaultOptions') can be used as the
173+data ToArgs res arity a where
155− -- default generic implementation of 'toEncoding'.
174+ NoToArgs :: ToArgs res Zero a
156− gToEncoding :: Options -> f a -> Encoding
175+ To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
159-- | A configurable generic JSON creator. This function applied to
177-- | A configurable generic JSON creator. This function applied to
160-- 'defaultOptions' is used as the default for 'toJSON' when the type
178-- 'defaultOptions' is used as the default for 'toJSON' when the type
161-- is an instance of 'Generic'.
179-- is an instance of 'Generic'.
162−genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value
180+genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
181+ => Options -> a -> Value
163−genericToJSON opts = gToJSON opts . from
182+genericToJSON opts = gToJSON opts NoToArgs . from
184+-- | A configurable generic JSON creator. This function applied to
185+-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186+-- is an instance of 'Generic1'.
187+genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
188+ => Options -> (a -> Value) -> ([a] -> Value)
190+genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
165-- | A configurable generic JSON encoder. This function applied to
192-- | A configurable generic JSON encoder. This function applied to
166-- 'defaultOptions' is used as the default for 'toEncoding' when the type
193-- 'defaultOptions' is used as the default for 'toEncoding' when the type
167-- is an instance of 'Generic'.
194-- is an instance of 'Generic'.
168−genericToEncoding :: (Generic a, GToEncoding (Rep a)) => Options -> a -> Encoding
195+genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
196+ => Options -> a -> Encoding
169−genericToEncoding opts = gToEncoding opts . from
197+genericToEncoding opts = gToJSON opts NoToArgs . from
199+-- | A configurable generic JSON encoder. This function applied to
200+-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201+-- is an instance of 'Generic1'.
202+genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
203+ => Options -> (a -> Encoding) -> ([a] -> Encoding)
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
171-------------------------------------------------------------------------------
207-------------------------------------------------------------------------------
@@ -174,6 +210,9 @@ genericToEncoding opts = gToEncoding opts . from
175-- | A type that can be converted to JSON.
211-- | A type that can be converted to JSON.
213+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214+-- to) specify 'toEncoding'.
177-- An example type and instance:
216-- An example type and instance:
@@ -182,10 +221,10 @@ genericToEncoding opts = gToEncoding opts . from
183-- data Coord = Coord { x :: Double, y :: Double }
222-- data Coord = Coord { x :: Double, y :: Double }
185−-- instance ToJSON Coord where
224+-- instance 'ToJSON' Coord where
186−-- toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
188−-- toEncoding (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
191-- Instead of manually writing your 'ToJSON' instance, there are two options
230-- Instead of manually writing your 'ToJSON' instance, there are two options
@@ -193,17 +232,15 @@ genericToEncoding opts = gToEncoding opts . from
194-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
233-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
195-- instance at compile time. The generated instance is optimized for your type
234-- instance at compile time. The generated instance is optimized for your type
196−-- so will probably be more efficient than the following two options:
235+-- so it will probably be more efficient than the following option.
198-- * The compiler can provide a default generic implementation for
237-- * The compiler can provide a default generic implementation for
199-- 'toJSON'.
238-- 'toJSON'.
201-- To use the second, simply add a @deriving 'Generic'@ clause to your
240-- To use the second, simply add a @deriving 'Generic'@ clause to your
202−-- datatype and declare a 'ToJSON' instance for your datatype without giving
241+-- datatype and declare a 'ToJSON' instance. If you require nothing other than
203−-- definitions for 'toJSON' or 'toEncoding'.
242+-- 'defaultOptions', it is sufficient to write (and this is the only
204−--
243+-- alternative where the default 'toJSON' implementation is sufficient):
205−-- For example, the previous example can be simplified to a more
209-- {-\# LANGUAGE DeriveGeneric \#-}
246-- {-\# LANGUAGE DeriveGeneric \#-}
@@ -212,35 +249,46 @@ genericToEncoding opts = gToEncoding opts . from
213-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
250-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
215−-- instance ToJSON Coord where
252+-- instance 'ToJSON' Coord where
216−-- toEncoding = 'genericToEncoding' 'defaultOptions'
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
219−-- Why do we provide an implementation for 'toEncoding' here? The
256+-- If on the other hand you wish to customize the generic decoding, you have
220−-- 'toEncoding' function is a relatively new addition to this class.
257+-- to implement both methods:
221−-- To allow users of older versions of this library to upgrade without
222−-- having to edit all of their instances or encounter surprising
223−-- incompatibilities, the default implementation of 'toEncoding' uses
224−-- 'toJSON'. This produces correct results, but since it performs an
225−-- intermediate conversion to a 'Value', it will be less efficient
226−-- than directly emitting an 'Encoding'. Our one-liner definition of
227−-- 'toEncoding' above bypasses the intermediate 'Value'.
229−-- If @DefaultSignatures@ doesn't give exactly the results you want,
230−-- you can customize the generic encoding with only a tiny amount of
231−-- effort, using 'genericToJSON' and 'genericToEncoding' with your
232−-- preferred 'Options':
260+-- customOptions = 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
235−-- instance ToJSON Coord where
264+-- instance 'ToJSON' Coord where
236−-- toJSON = 'genericToJSON' 'defaultOptions'
265+-- 'toJSON' = 'genericToJSON' customOptions
237−-- toEncoding = 'genericToEncoding' 'defaultOptions'
266+-- 'toEncoding' = 'genericToEncoding' customOptions
269+-- Previous versions of this library only had the 'toJSON' method. Adding
270+-- 'toEncoding' had two reasons:
272+-- 1. toEncoding is more efficient for the common case that the output of
273+-- 'toJSON' is directly serialized to a @ByteString@.
274+-- Further, expressing either method in terms of the other would be
277+-- 2. The choice of defaults allows a smooth transition for existing users:
278+-- Existing instances that do not define 'toEncoding' still
279+-- compile and have the correct semantics. This is ensured by making
280+-- the default implementation of 'toEncoding' use 'toJSON'. This produces
281+-- correct results, but since it performs an intermediate conversion to a
282+-- 'Value', it will be less efficient than directly emitting an 'Encoding'.
283+-- (this also means that specifying nothing more than
284+-- @instance ToJSON Coord@ would be sufficient as a generically decoding
285+-- instance, but there probably exists no good reason to not specify
286+-- 'toEncoding' in new instances.)
239class ToJSON a where
287class ToJSON a where
240 -- | Convert a Haskell value to a JSON-friendly intermediate type.
288 -- | Convert a Haskell value to a JSON-friendly intermediate type.
241 toJSON :: a -> Value
289 toJSON :: a -> Value
243− default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
244 toJSON = genericToJSON defaultOptions
292 toJSON = genericToJSON defaultOptions
246 -- | Encode a Haskell value as JSON.
294 -- | Encode a Haskell value as JSON.
@@ -257,12 +305,12 @@ class ToJSON a where
257 -- extension, and then have GHC generate a method body as follows.
305 -- extension, and then have GHC generate a method body as follows.
260− -- instance ToJSON Coord where
308+ -- instance 'ToJSON' Coord where
261− -- toEncoding = 'genericToEncoding' 'defaultOptions'
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
264 toEncoding :: a -> Encoding
312 toEncoding :: a -> Encoding
265− toEncoding = E.Encoding . EB.encodeToBuilder . toJSON
313+ toEncoding = E.value . toJSON
266 {-# INLINE toEncoding #-}
314 {-# INLINE toEncoding #-}
268 toJSONList :: [a] -> Value
316 toJSONList :: [a] -> Value
@@ -283,46 +331,280 @@ class KeyValue kv where
283 infixr 8 .=
331 infixr 8 .=
285instance KeyValue Series where
333instance KeyValue Series where
286− name .= value = E.Value $ E.text name <> E.colon <> toEncoding value
334+ name .= value = E.pair name (toEncoding value)
287 {-# INLINE (.=) #-}
335 {-# INLINE (.=) #-}
289instance KeyValue Pair where
337instance KeyValue Pair where
290 name .= value = (name, toJSON value)
338 name .= value = (name, toJSON value)
291 {-# INLINE (.=) #-}
339 {-# INLINE (.=) #-}
341+-- | Constructs a singleton 'H.HashMap'. For calling functions that
342+-- demand an 'Object' for constructing objects. To be used in
343+-- conjunction with 'mconcat'. Prefer to use 'object' where possible.
344+instance KeyValue Object where
345+ name .= value = H.singleton name (toJSON value)
293-------------------------------------------------------------------------------
348-------------------------------------------------------------------------------
294-- Classes and types for map keys
349-- Classes and types for map keys
295-------------------------------------------------------------------------------
350-------------------------------------------------------------------------------
352+-- | Typeclass for types that can be used as the key of a map-like container
353+-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
354+-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
355+-- type 'Map' 'Text' 'Char':
357+-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
360+-- Since 'Int' also has a 'ToJSONKey' instance, we can similarly write:
362+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(5 :: Int, 'a')]
365+-- JSON documents only accept strings as object keys. For any type
366+-- from @base@ that has a natural textual representation, it can be
367+-- expected that its 'ToJSONKey' instance will choose that representation.
369+-- For data types that lack a natural textual representation, an alternative
370+-- is provided. The map-like container is represented as a JSON array
371+-- instead of a JSON object. Each value in the array is an array with
372+-- exactly two values. The first is the key and the second is the value.
374+-- For example, values of type '[Text]' cannot be encoded to a
375+-- string, so a 'Map' with keys of type '[Text]' is encoded as follows:
377+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(["foo","bar","baz" :: Text], 'a')]
378+-- [[["foo","bar","baz"],"a"]]
380+-- The default implementation of 'ToJSONKey' chooses this method of
381+-- encoding a key, using the 'ToJSON' instance of the type.
383+-- To use your own data type as the key in a map, all that is needed
384+-- is to write a 'ToJSONKey' (and possibly a 'FromJSONKey') instance
385+-- for it. If the type cannot be trivially converted to and from 'Text',
386+-- it is recommended that 'ToJSONKeyValue' is used. Since the default
387+-- implementations of the typeclass methods can build this from a
388+-- 'ToJSON' instance, there is nothing that needs to be written:
390+-- > data Foo = Foo { fooAge :: Int, fooName :: Text }
391+-- > deriving (Eq,Ord,Generic)
392+-- > instance ToJSON Foo
393+-- > instance ToJSONKey Foo
395+-- That's it. We can now write:
397+-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
398+-- >>> LBC8.putStrLn $ encode m
399+-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
401+-- The next case to consider is if we have a type that is a
402+-- newtype wrapper around 'Text'. The recommended approach is to use
403+-- generalized newtype deriving:
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
406+-- > deriving (Eq,Ord,ToJSONKey)
408+-- Then we may write:
410+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
413+-- Simple sum types are a final case worth considering. Suppose we have:
415+-- > data Color = Red | Green | Blue
416+-- > deriving (Show,Read,Eq,Ord)
418+-- 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
420+-- and from 'Text' that does not require any escape sequences. So
421+-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
422+-- as objects instead of arrays of pairs. This instance may be
423+-- implemented using generics as follows:
426+-- instance 'ToJSONKey' Color where
427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
430+-- === __Low-level implementations__
432+-- The 'Show' instance can be used to help write 'ToJSONKey':
434+-- > instance ToJSONKey Color where
435+-- > toJSONKey = ToJSONKeyText f g
436+-- > where f = Text.pack . show
437+-- > g = text . Text.pack . show
438+-- > -- text function is from Data.Aeson.Encoding
440+-- The situation of needing to turning function @a -> Text@ into
441+-- a 'ToJSONKeyFunction' is common enough that a special combinator
442+-- is provided for it. The above instance can be rewritten as:
444+-- > instance ToJSONKey Color where
445+-- > toJSONKey = toJSONKeyText (Text.pack . show)
447+-- The performance of the above instance can be improved by
448+-- not using 'String' as an intermediate step when converting to
449+-- 'Text'. One option for improving performance would be to use
450+-- template haskell machinery from the @text-show@ package. However,
451+-- even with the approach, the 'Encoding' (a wrapper around a bytestring
452+-- builder) is generated by encoding the 'Text' to a 'ByteString',
453+-- an intermediate step that could be avoided. The fastest possible
454+-- implementation would be:
456+-- > -- Assuming that OverloadedStrings is enabled
457+-- > instance ToJSONKey Color where
458+-- > toJSONKey = ToJSONKeyText f g
459+-- > where f x = case x of {Red -> "Red";Green ->"Green";Blue -> "Blue"}
460+-- > g x = case x of {Red -> text "Red";Green -> text "Green";Blue -> text "Blue"}
461+-- > -- text function is from Data.Aeson.Encoding
463+-- This works because GHC can lift the encoded values out of the case
464+-- statements, which means that they are only evaluated once. This
465+-- approach should only be used when there is a serious need to
466+-- maximize performance.
297class ToJSONKey a where
468class ToJSONKey a where
469+ -- | Strategy for rendering the key for a map-like container.
298 toJSONKey :: ToJSONKeyFunction a
470 toJSONKey :: ToJSONKeyFunction a
299 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
471 default toJSONKey :: ToJSON a => ToJSONKeyFunction a
300− toJSONKey = ToJSONKeyValue (toJSON, toEncoding)
472+ toJSONKey = ToJSONKeyValue toJSON toEncoding
474+ -- | This is similar in spirit to the 'showsList' method of 'Show'.
475+ -- It makes it possible to give 'String' keys special treatment
476+ -- without using @OverlappingInstances@. End users should always
477+ -- be able to use the default implementation of this method.
301 toJSONKeyList :: ToJSONKeyFunction [a]
478 toJSONKeyList :: ToJSONKeyFunction [a]
302 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
479 default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
303− toJSONKeyList = ToJSONKeyValue (toJSON, toEncoding)
480+ toJSONKeyList = ToJSONKeyValue toJSON toEncoding
305data ToJSONKeyFunction a
482data ToJSONKeyFunction a
306− = ToJSONKeyText (a -> Text, a -> Encoding)
483+ = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
484+ -- ^ key is encoded to string, produces object
307− | ToJSONKeyValue (a -> Value, a -> Encoding)
485+ | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
486+ -- ^ key is encoded to value, produces array
488+-- | Helper for creating textual keys.
491+-- instance 'ToJSONKey' MyKey where
492+-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
494+-- myKeyToText = Text.pack . show -- or showt from text-show
496+toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
497+toJSONKeyText f = ToJSONKeyText f (E.text . f)
499+-- | TODO: should this be exported?
500+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
501+toJSONKeyTextEnc e = ToJSONKeyText tot e
503+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504+ tot = T.dropAround (== '"')
507+ . E.encodingToLazyByteString
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
513+-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
309contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
514contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
310contramapToJSONKeyFunction h x = case x of
515contramapToJSONKeyFunction h x = case x of
311− ToJSONKeyText (f,g) -> ToJSONKeyText (f . h, g . h)
516+ ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
312− ToJSONKeyValue (f,g) -> ToJSONKeyValue (f . h, g . h)
517+ ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
519+-- 'toJSONKey' for 'Generic' types.
520+-- Deriving is supported for enumeration types, i.e. the sums of nullary
521+-- constructors. The names of constructors will be used as keys for JSON
524+-- See also 'genericFromJSONKey'.
529+-- data Color = Red | Green | Blue
530+-- deriving 'Generic'
532+-- instance 'ToJSONKey' Color where
533+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
535+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
536+ => JSONKeyOptions -> ToJSONKeyFunction a
537+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)
539+class GetConName f => GToJSONKey f
540+instance GetConName f => GToJSONKey f
314-------------------------------------------------------------------------------
542-------------------------------------------------------------------------------
315-- Lifings of FromJSON and ToJSON to unary and binary type constructors
543-- Lifings of FromJSON and ToJSON to unary and binary type constructors
316-------------------------------------------------------------------------------
544-------------------------------------------------------------------------------
318-- | Lifting of the 'ToJSON' class to unary type constructors.
547-- | Lifting of the 'ToJSON' class to unary type constructors.
549+-- Instead of manually writing your 'ToJSON1' instance, there are two options
550+-- to do it automatically:
552+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553+-- instance at compile time. The generated instance is optimized for your type
554+-- so it will probably be more efficient than the following option.
556+-- * The compiler can provide a default generic implementation for
559+-- To use the second, simply add a @deriving 'Generic1'@ clause to your
560+-- datatype and declare a 'ToJSON1' instance for your datatype without giving
561+-- definitions for 'liftToJSON' or 'liftToEncoding'.
566+-- {-\# LANGUAGE DeriveGeneric \#-}
568+-- import "GHC.Generics"
570+-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
575+-- If the default implementation doesn't give exactly the results you want,
576+-- you can customize the generic encoding with only a tiny amount of
577+-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578+-- your preferred 'Options':
581+-- customOptions = 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
590+-- See also 'ToJSON'.
319class ToJSON1 f where
591class ToJSON1 f where
320 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
592 liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
595+ => (a -> Value) -> ([a] -> Value) -> f a -> Value
596+ liftToJSON = genericLiftToJSON defaultOptions
321 liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
598 liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
322 liftToJSONList f g = listValue (liftToJSON f g)
599 liftToJSONList f g = listValue (liftToJSON f g)
324− -- | Unfortunately there cannot be a default implementation of 'liftToEncoding'.
325 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
601 liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
604+ => (a -> Encoding) -> ([a] -> Encoding)
606+ liftToEncoding = genericLiftToEncoding defaultOptions
326 liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
608 liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
327 liftToEncodingList f g = listEncoding (liftToEncoding f g)
609 liftToEncodingList f g = listEncoding (liftToEncoding f g)
@@ -336,8 +618,13 @@ toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
336toEncoding1 = liftToEncoding toEncoding toEncodingList
618toEncoding1 = liftToEncoding toEncoding toEncodingList
337{-# INLINE toEncoding1 #-}
619{-# INLINE toEncoding1 #-}
340-- | Lifting of the 'ToJSON' class to binary type constructors.
621-- | Lifting of the 'ToJSON' class to binary type constructors.
623+-- Instead of manually writing your 'ToJSON2' instance, "Data.Aeson.TH"
624+-- provides Template Haskell functions which will derive an instance at compile time.
626+-- The compiler cannot provide a default generic implementation for 'liftToJSON2',
627+-- unlike 'toJSON' and 'liftToJSON'.
341class ToJSON2 f where
628class ToJSON2 f where
342 liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
629 liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
343 liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
630 liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
@@ -361,9 +648,25 @@ toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingLis
361-- Encoding functions
648-- Encoding functions
362-------------------------------------------------------------------------------
649-------------------------------------------------------------------------------
651+-- | Helper function to use with 'liftToEncoding'.
652+-- Useful when writing own 'ToJSON1' instances.
655+-- newtype F a = F [a]
657+-- -- This instance encodes 'String' as an array of chars
658+-- instance 'ToJSON1' F where
659+-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660+-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
662+-- instance 'Data.Aeson.FromJSON.FromJSON1' F where
663+-- 'Data.Aeson.FromJSON.liftParseJSON' p _ v = F \<$\> 'Data.Aeson.FromJSON.liftParseJSON' p ('Data.Aeson.FromJSON.listParser' p) v
364listEncoding :: (a -> Encoding) -> [a] -> Encoding
665listEncoding :: (a -> Encoding) -> [a] -> Encoding
365listEncoding = E.list
666listEncoding = E.list
667+{-# INLINE listEncoding #-}
669+-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
367listValue :: (a -> Value) -> [a] -> Value
670listValue :: (a -> Value) -> [a] -> Value
368listValue f = Array . V.fromList . map f
671listValue f = Array . V.fromList . map f
369{-# INLINE listValue #-}
672{-# INLINE listValue #-}
@@ -382,6 +685,11 @@ instance ToJSON1 [] where
382 {-# INLINE liftToEncoding #-}
685 {-# INLINE liftToEncoding #-}
384instance (ToJSON a) => ToJSON [a] where
687instance (ToJSON a) => ToJSON [a] where
688+ {-# SPECIALIZE instance ToJSON String #-}
689+ {-# SPECIALIZE instance ToJSON [String] #-}
690+ {-# SPECIALIZE instance ToJSON [Array] #-}
691+ {-# SPECIALIZE instance ToJSON [Object] #-}
385 toJSON = toJSON1
693 toJSON = toJSON1
386 {-# INLINE toJSON #-}
694 {-# INLINE toJSON #-}
@@ -392,214 +700,260 @@ instance (ToJSON a) => ToJSON [a] where
392-- Generic toJSON / toEncoding
700-- Generic toJSON / toEncoding
393-------------------------------------------------------------------------------
701-------------------------------------------------------------------------------
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 #-}
395--------------------------------------------------------------------------------
744--------------------------------------------------------------------------------
396-- Generic toJSON
745-- 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
398−instance OVERLAPPABLE_ (GToJSON a) => GToJSON (M1 i c a) where
751+instance GToJSON Value arity V1 where
399− -- Meta-information, which is not handled elsewhere, is ignored:
752+ -- Empty values do not exist, which makes the job of formatting them
400− gToJSON opts = gToJSON opts . unM1
753+ -- rather easy:
754+ gToJSON _ _ x = x `seq` error "case: V1"
755+ {-# INLINE gToJSON #-}
402−instance (ToJSON a) => GToJSON (K1 i a) where
757+instance ToJSON a => GToJSON Value arity (K1 i a) where
403 -- Constant values are encoded using their ToJSON instance:
758 -- Constant values are encoded using their ToJSON instance:
404− gToJSON _opts = toJSON . unK1
759+ gToJSON _opts _ = toJSON . unK1
760+ {-# INLINE gToJSON #-}
406−instance GToJSON U1 where
762+instance ToJSON1 f => GToJSON Value One (Rec1 f) where
407− -- Empty constructors are encoded to an empty array:
763+ -- Recursive occurrences of the last type parameter are encoded using their
408− gToJSON _opts _ = emptyArray
764+ -- ToJSON1 instance:
765+ gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766+ {-# INLINE gToJSON #-}
410−instance (ConsToJSON a) => GToJSON (C1 c a) where
768+instance GToJSON Value arity U1 where
411− -- Constructors need to be encoded differently depending on whether they're
769+ -- Empty constructors are encoded to an empty array:
412− -- a record or not. This distinction is made by 'consToJSON':
770+ gToJSON _opts _ _ = emptyArray
413− gToJSON opts = consToJSON opts . unM1
771+ {-# INLINE gToJSON #-}
415−instance ( WriteProduct a, WriteProduct b
773+instance ( WriteProduct arity a, WriteProduct arity b
416− , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where
774+ , ProductSize a, ProductSize b
775+ ) => GToJSON Value arity (a :*: b)
417 -- Products are encoded to an array. Here we allocate a mutable vector of
777 -- Products are encoded to an array. Here we allocate a mutable vector of
418 -- the same size as the product and write the product's elements to it using
778 -- the same size as the product and write the product's elements to it using
419 -- 'writeProduct':
779 -- 'writeProduct':
420− gToJSON opts p =
780+ gToJSON opts targs p =
421 Array $ V.create $ do
781 Array $ V.create $ do
422 mv <- VM.unsafeNew lenProduct
782 mv <- VM.unsafeNew lenProduct
423− writeProduct opts mv 0 lenProduct p
783+ writeProduct opts targs mv 0 lenProduct p
424 return mv
784 return mv
426 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
786 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
427 productSize
787 productSize
428−
788+ {-# INLINE gToJSON #-}
429−instance ( AllNullary (a :+: b) allNullary
789+
430− , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where
790+instance ( ToJSON1 f
431− -- If all constructors of a sum datatype are nullary and the
791+ , GToJSON Value One g
432− -- 'allNullaryToStringTag' option is set they are encoded to
792+ ) => GToJSON Value One (f :.: g)
433− -- strings. This distinction is made by 'sumToJSON':
793+ where
434− gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)
794+ -- If an occurrence of the last type parameter is nested inside two
435− . sumToJSON opts
795+ -- composed types, it is encoded by using the outermost type's ToJSON1
796+ -- instance to generically encode the innermost type:
797+ gToJSON opts targs =
798+ let gtj = gToJSON opts targs in
799+ liftToJSON gtj (listValue gtj) . unComp1
800+ {-# INLINE gToJSON #-}
437--------------------------------------------------------------------------------
802--------------------------------------------------------------------------------
438-- Generic toEncoding
803-- Generic toEncoding
440−instance OVERLAPPABLE_ (GToEncoding a) => GToEncoding (M1 i c a) where
441− -- Meta-information, which is not handled elsewhere, is ignored:
442− gToEncoding opts = gToEncoding opts . unM1
444−instance (ToJSON a) => GToEncoding (K1 i a) where
805+instance ToJSON a => GToJSON Encoding arity (K1 i a) where
445 -- Constant values are encoded using their ToJSON instance:
806 -- Constant values are encoded using their ToJSON instance:
446− gToEncoding _opts = toEncoding . unK1
807+ gToJSON _opts _ = toEncoding . unK1
808+ {-# INLINE gToJSON #-}
448−instance GToEncoding U1 where
810+instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
449− -- Empty constructors are encoded to an empty array:
811+ -- Recursive occurrences of the last type parameter are encoded using their
450− gToEncoding _opts _ = E.emptyArray_
812+ -- ToEncoding1 instance:
813+ gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814+ {-# INLINE gToJSON #-}
452−instance (ConsToEncoding a) => GToEncoding (C1 c a) where
816+instance GToJSON Encoding arity U1 where
453− -- Constructors need to be encoded differently depending on whether they're
817+ -- Empty constructors are encoded to an empty array:
454− -- a record or not. This distinction is made by 'consToEncoding':
818+ gToJSON _opts _ _ = E.emptyArray_
455− gToEncoding opts = consToEncoding opts . unM1
819+ {-# INLINE gToJSON #-}
457−instance ( EncodeProduct a, EncodeProduct b ) => GToEncoding (a :*: b) where
821+instance ( EncodeProduct arity a
822+ , EncodeProduct arity b
823+ ) => GToJSON Encoding arity (a :*: b)
458 -- Products are encoded to an array. Here we allocate a mutable vector of
825 -- Products are encoded to an array. Here we allocate a mutable vector of
459 -- the same size as the product and write the product's elements to it using
826 -- the same size as the product and write the product's elements to it using
460 -- 'encodeProduct':
827 -- 'encodeProduct':
461− gToEncoding opts p = E.tuple $ encodeProduct opts p
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
462−
829+ {-# INLINE gToJSON #-}
463−instance ( AllNullary (a :+: b) allNullary
830+
464− , SumToEncoding (a :+: b) allNullary ) => GToEncoding (a :+: b) where
831+instance ( ToJSON1 f
465− -- If all constructors of a sum datatype are nullary and the
832+ , GToJSON Encoding One g
466− -- 'allNullaryToStringTag' option is set they are encoded to
833+ ) => GToJSON Encoding One (f :.: g)
467− -- strings. This distinction is made by 'sumToEncoding':
834+ where
468− gToEncoding opts
835+ -- If an occurrence of the last type parameter is nested inside two
469− = (unTagged :: Tagged allNullary Encoding -> Encoding)
836+ -- composed types, it is encoded by using the outermost type's ToJSON1
470− . sumToEncoding opts
837+ -- instance to generically encode the innermost type:
838+ gToJSON opts targs =
839+ let gte = gToJSON opts targs in
840+ liftToEncoding gte (listEncoding gte) . unComp1
841+ {-# INLINE gToJSON #-}
472--------------------------------------------------------------------------------
843--------------------------------------------------------------------------------
474−class SumToJSON f allNullary where
845+class SumToJSON enc arity f allNullary where
846+ sumToJSON :: Options -> ToArgs enc arity a
475− sumToJSON :: Options -> f a -> Tagged allNullary Value
847+ -> f a -> Tagged allNullary enc
477−instance ( GetConName f
849+instance ( GetConName f
478− , TaggedObjectPairs f
850+ , FromString enc
479− , ObjectWithSingleFieldObj f
851+ , TaggedObject enc arity f
852+ , SumToJSON' ObjectWithSingleField enc arity f
853+ , SumToJSON' TwoElemArray enc arity f
854+ , SumToJSON' UntaggedValue enc arity f
480− , TwoElemArrayObj f ) => SumToJSON f True where
855+ ) => SumToJSON enc arity f True
481− sumToJSON opts
857+ sumToJSON opts targs
482− | allNullaryToStringTag opts = Tagged . String . pack
858+ | allNullaryToStringTag opts = Tagged . fromString
483 . constructorTagModifier opts . getConName
859 . constructorTagModifier opts . getConName
484− | otherwise = Tagged . nonAllNullarySumToJSON opts
860+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs
486−instance ( TwoElemArrayObj f
862+instance ( TaggedObject enc arity f
487− , TaggedObjectPairs f
863+ , SumToJSON' ObjectWithSingleField enc arity f
864+ , SumToJSON' TwoElemArray enc arity f
865+ , SumToJSON' UntaggedValue enc arity f
488− , ObjectWithSingleFieldObj f ) => SumToJSON f False where
866+ ) => SumToJSON enc arity f False
489− sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
868+ sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
491−nonAllNullarySumToJSON :: ( TwoElemArrayObj f
870+nonAllNullarySumToJSON :: ( TaggedObject enc arity f
492− , TaggedObjectPairs f
871+ , SumToJSON' ObjectWithSingleField enc arity f
493− , ObjectWithSingleFieldObj f
872+ , SumToJSON' TwoElemArray enc arity f
494− ) => Options -> f a -> Value
873+ , SumToJSON' UntaggedValue enc arity f
874+ ) => Options -> ToArgs enc arity a
495−nonAllNullarySumToJSON opts =
876+nonAllNullarySumToJSON opts targs =
496 case sumEncoding opts of
877 case sumEncoding opts of
498− object . taggedObjectPairs opts tagFieldName contentsFieldName
499− ObjectWithSingleField -> Object . objectWithSingleFieldObj opts
500− TwoElemArray -> Array . twoElemArrayObj opts
502−--------------------------------------------------------------------------------
504−class SumToEncoding f allNullary where
505− sumToEncoding :: Options -> f a -> Tagged allNullary Encoding
507−instance ( GetConName f
509− , ObjectWithSingleFieldEnc f
510− , TwoElemArrayEnc f ) => SumToEncoding f True where
512− | allNullaryToStringTag opts = Tagged . toEncoding .
513− constructorTagModifier opts . getConName
514− | otherwise = Tagged . nonAllNullarySumToEncoding opts
516−instance ( TwoElemArrayEnc f
518− , ObjectWithSingleFieldEnc f ) => SumToEncoding f False where
519− sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts
521−nonAllNullarySumToEncoding :: ( TwoElemArrayEnc f
523− , ObjectWithSingleFieldEnc f
524− ) => Options -> f a -> Encoding
525−nonAllNullarySumToEncoding opts =
526− case sumEncoding opts of
527 TaggedObject{..} ->
879 TaggedObject{..} ->
528− taggedObjectEnc opts tagFieldName contentsFieldName
880+ taggedObject opts targs tagFieldName contentsFieldName
529− ObjectWithSingleField -> objectWithSingleFieldEnc opts
530− TwoElemArray -> twoElemArrayEnc opts
532−--------------------------------------------------------------------------------
534−class TaggedObjectPairs f where
882+ ObjectWithSingleField ->
535− taggedObjectPairs :: Options -> String -> String -> f a -> [Pair]
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
537−instance ( TaggedObjectPairs a
886+ TwoElemArray ->
538− , TaggedObjectPairs b ) => TaggedObjectPairs (a :+: b) where
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
539− taggedObjectPairs opts tagFieldName contentsFieldName (L1 x) =
888+ . sumToJSON' opts targs
540− taggedObjectPairs opts tagFieldName contentsFieldName x
541− taggedObjectPairs opts tagFieldName contentsFieldName (R1 x) =
542− taggedObjectPairs opts tagFieldName contentsFieldName x
544−instance ( IsRecord a isRecord
890+ UntaggedValue ->
545− , TaggedObjectPairs' a isRecord
546− , Constructor c ) => TaggedObjectPairs (C1 c a) where
547− taggedObjectPairs opts tagFieldName contentsFieldName =
548− (pack tagFieldName .= constructorTagModifier opts
549− (conName (undefined :: t c a p)) :) .
550− (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
551− taggedObjectPairs' opts contentsFieldName . unM1
892+ . sumToJSON' opts targs
553−class TaggedObjectPairs' f isRecord where
894+--------------------------------------------------------------------------------
554− taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]
556−instance OVERLAPPING_ TaggedObjectPairs' U1 False where
896+class FromString enc where
557− taggedObjectPairs' _ _ _ = Tagged []
897+ fromString :: String -> enc
559−instance (RecordToPairs f) => TaggedObjectPairs' f True where
899+instance FromString Encoding where
560− taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts
900+ fromString = toEncoding
562−instance (GToJSON f) => TaggedObjectPairs' f False where
902+instance FromString Value where
563− taggedObjectPairs' opts contentsFieldName =
903+ fromString = String . pack
564− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
566--------------------------------------------------------------------------------
905--------------------------------------------------------------------------------
568−class TaggedObjectEnc f where
907+class TaggedObject enc arity f where
569− taggedObjectEnc :: Options -> String -> String -> f a -> Encoding
908+ taggedObject :: Options -> ToArgs enc arity a
570−
909+ -> String -> String
571−instance ( TaggedObjectEnc a
910+ -> f a -> enc
572− , TaggedObjectEnc b ) => TaggedObjectEnc (a :+: b) where
911+
912+instance ( TaggedObject enc arity a
913+ , TaggedObject enc arity b
914+ ) => TaggedObject enc arity (a :+: b)
573− taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
574− taggedObjectEnc opts tagFieldName contentsFieldName x
917+ taggedObject opts targs tagFieldName contentsFieldName x
575− taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
576− taggedObjectEnc opts tagFieldName contentsFieldName x
919+ taggedObject opts targs tagFieldName contentsFieldName x
578−instance ( IsRecord a isRecord
921+instance ( IsRecord a isRecord
579− , TaggedObjectEnc' a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
925+ , KeyValuePair enc pairs
580− , Constructor c ) => TaggedObjectEnc (C1 c a) where
926+ , Constructor c
927+ ) => TaggedObject enc arity (C1 c a)
581− taggedObjectEnc opts tagFieldName contentsFieldName v =
929+ taggedObject opts targs tagFieldName contentsFieldName =
582− E.openCurly <>
930+ fromPairs . mappend tag . contents
583− (toEncoding tagFieldName <>
931+ where
584− E.colon <>
932+ tag = tagFieldName `pair`
585− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))) <>
933+ (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
586− ((unTagged :: Tagged isRecord Encoding -> Encoding) .
936+ (unTagged :: Tagged isRecord pairs -> pairs) .
587− taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
937+ taggedObject' opts targs contentsFieldName . unM1
590−class TaggedObjectEnc' f isRecord where
939+class TaggedObject' enc pairs arity f isRecord where
940+ taggedObject' :: Options -> ToArgs enc arity a
591− taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord Encoding
941+ -> String -> f a -> Tagged isRecord pairs
943+instance ( GToJSON enc arity f
944+ , KeyValuePair enc pairs
945+ ) => TaggedObject' enc pairs arity f False
947+ taggedObject' opts targs contentsFieldName =
948+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs
593−instance OVERLAPPING_ TaggedObjectEnc' U1 False where
950+instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
594− taggedObjectEnc' _ _ _ = Tagged mempty
951+ taggedObject' _ _ _ _ = Tagged mempty
596−instance (RecordToEncoding f) => TaggedObjectEnc' f True where
953+instance ( RecordToPairs enc pairs arity f
597− taggedObjectEnc' opts _ = Tagged . (E.comma <>) . fst . recordToEncoding opts
954+ ) => TaggedObject' enc pairs arity f True
599−instance (GToEncoding f) => TaggedObjectEnc' f False where
956+ taggedObject' opts targs _ = Tagged . recordToPairs opts targs
600− taggedObjectEnc' opts contentsFieldName =
601− Tagged . (\z -> E.comma <> toEncoding contentsFieldName <> E.colon <> z) .
604--------------------------------------------------------------------------------
958--------------------------------------------------------------------------------
@@ -614,248 +968,251 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where
614instance (Constructor c) => GetConName (C1 c a) where
968instance (Constructor c) => GetConName (C1 c a) where
615 getConName = conName
969 getConName = conName
617−--------------------------------------------------------------------------------
971+-- For genericToJSONKey
618−
972+instance GetConName a => GetConName (D1 d a) where
619−class TwoElemArrayObj f where
973+ getConName (M1 x) = getConName x
620− twoElemArrayObj :: Options -> f a -> V.Vector Value
622−instance (TwoElemArrayObj a, TwoElemArrayObj b) => TwoElemArrayObj (a :+: b) where
623− twoElemArrayObj opts (L1 x) = twoElemArrayObj opts x
624− twoElemArrayObj opts (R1 x) = twoElemArrayObj opts x
626−instance ( GToJSON a, ConsToJSON a
627− , Constructor c ) => TwoElemArrayObj (C1 c a) where
628− twoElemArrayObj opts x = V.create $ do
629− mv <- VM.unsafeNew 2
630− VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
631− $ conName (undefined :: t c a p)
632− VM.unsafeWrite mv 1 $ gToJSON opts x
635--------------------------------------------------------------------------------
975--------------------------------------------------------------------------------
637−class TwoElemArrayEnc f where
977+-- Reflection of SumEncoding variants
638− twoElemArrayEnc :: Options -> f a -> Encoding
640−instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) where
979+data ObjectWithSingleField
641− twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
980+data TwoElemArray
642− twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x
981+data UntaggedValue
644−instance ( GToEncoding a, ConsToEncoding a
645− , Constructor c ) => TwoElemArrayEnc (C1 c a) where
646− twoElemArrayEnc opts x = E.tuple $
647− toEncoding (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
650--------------------------------------------------------------------------------
983--------------------------------------------------------------------------------
652−class ConsToJSON f where
985+class SumToJSON' s enc arity f where
653− consToJSON :: Options -> f a -> Value
986+ sumToJSON' :: Options -> ToArgs enc arity a
655−class ConsToJSON' f isRecord where
656− consToJSON' :: Options -> Bool -- ^ Are we a record with one field?
657− -> f a -> Tagged isRecord Value
987+ -> f a -> Tagged s enc
659−instance ( IsRecord f isRecord
660− , ConsToJSON' f isRecord ) => ConsToJSON f where
661− consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)
662− . consToJSON' opts (isUnary (undefined :: f a))
664−instance (RecordToPairs f) => ConsToJSON' f True where
665− consToJSON' opts isUn f = let
666− vals = toList $ recordToPairs opts f
667− in case (unwrapUnaryRecords opts,isUn,vals) of
668− (True,True,[(_,val)]) -> Tagged val
669− _ -> Tagged $ object vals
671−instance GToJSON f => ConsToJSON' f False where
989+instance ( SumToJSON' s enc arity a
672− consToJSON' opts _ = Tagged . gToJSON opts
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
674--------------------------------------------------------------------------------
996--------------------------------------------------------------------------------
676−class ConsToEncoding f where
998+instance ( GToJSON Value arity a
677− consToEncoding :: Options -> f a -> Encoding
999+ , ConsToJSON Value arity a
678−
1000+ , Constructor c
679−class ConsToEncoding' f isRecord where
1001+ ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
680− consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
1002+ sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
681− -> f a -> Tagged isRecord Encoding
1003+ mv <- VM.unsafeNew 2
682−
1004+ VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
683−instance ( IsRecord f isRecord
1005+ $ conName (undefined :: t c a p)
684− , ConsToEncoding' f isRecord ) => ConsToEncoding f where
1006+ VM.unsafeWrite mv 1 $ gToJSON opts targs x
685− consToEncoding opts = (unTagged :: Tagged isRecord Encoding -> Encoding)
1007+ return mv
686− . consToEncoding' opts (isUnary (undefined :: f a))
688−instance (RecordToEncoding f) => ConsToEncoding' f True where
689− consToEncoding' opts isUn x =
690− let (enc, mbVal) = recordToEncoding opts x
691− in case (unwrapUnaryRecords opts, isUn, mbVal) of
692− (True, True, Just val) -> Tagged val
693− _ -> Tagged $ E.wrapObject enc
695−instance GToEncoding f => ConsToEncoding' f False where
696− consToEncoding' opts _ = Tagged . gToEncoding opts
698--------------------------------------------------------------------------------
1009--------------------------------------------------------------------------------
700−class RecordToPairs f where
1011+instance ( GToJSON Encoding arity a
701− recordToPairs :: Options -> f a -> DList Pair
1012+ , ConsToJSON Encoding arity a
702−
1013+ , Constructor c
703−instance (RecordToPairs a, RecordToPairs b) => RecordToPairs (a :*: b) where
1014+ ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
704− recordToPairs opts (a :*: b) = recordToPairs opts a <>
1015+ where
705− recordToPairs opts b
1016+ sumToJSON' opts targs x = Tagged $ E.list id
1017+ [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
1018+ , gToJSON opts targs x
707−instance (Selector s, GToJSON a) => RecordToPairs (S1 s a) where
1021+--------------------------------------------------------------------------------
708− recordToPairs = fieldToPair
710−instance OVERLAPPING_ (Selector s, ToJSON a) =>
711− RecordToPairs (S1 s (K1 i (Maybe a))) where
712− recordToPairs opts (M1 k1) | omitNothingFields opts
713− , K1 Nothing <- k1 = DList.empty
714− recordToPairs opts m1 = fieldToPair opts m1
716−fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
1023+class ConsToJSON enc arity f where
717−fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
1024+ consToJSON :: Options -> ToArgs enc arity a
718− , gToJSON opts (unM1 m1)
1025+ -> f a -> enc
1027+class ConsToJSON' enc arity f isRecord where
1028+ consToJSON' :: Options -> ToArgs enc arity a
1029+ -> f a -> Tagged isRecord enc
1031+instance ( IsRecord f isRecord
1032+ , ConsToJSON' enc arity f isRecord
1033+ ) => ConsToJSON enc arity f
1035+ consToJSON opts targs =
1036+ (unTagged :: Tagged isRecord enc -> enc)
1037+ . consToJSON' opts targs
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
1046+ consToJSON' opts targs
1047+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049+ {-# INLINE consToJSON' #-}
1051+instance ( RecordToPairs enc pairs arity f
1052+ , FromPairs enc pairs
1053+ ) => ConsToJSON' enc arity f True
1055+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056+ {-# INLINE consToJSON' #-}
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1060+ {-# INLINE consToJSON' #-}
721--------------------------------------------------------------------------------
1062--------------------------------------------------------------------------------
723−class RecordToEncoding f where
1064+class RecordToPairs enc pairs arity f where
724 -- 1st element: whole thing
1065 -- 1st element: whole thing
725 -- 2nd element: in case the record has only 1 field, just the value
1066 -- 2nd element: in case the record has only 1 field, just the value
726 -- of the field (without the key); 'Nothing' otherwise
1067 -- of the field (without the key); 'Nothing' otherwise
727− recordToEncoding :: Options -> f a -> (Encoding, Maybe Encoding)
1068+ recordToPairs :: Options -> ToArgs enc arity a
728−
1069+ -> f a -> pairs
729−instance (RecordToEncoding a, RecordToEncoding b) => RecordToEncoding (a :*: b) where
1070+
730− recordToEncoding opts (a :*: b) | omitNothingFields opts =
1071+instance ( Monoid pairs
731− (mconcat $ intersperse E.comma $
1072+ , RecordToPairs enc pairs arity a
732− filter (not . E.nullEncoding)
1073+ , RecordToPairs enc pairs arity b
733− [fst (recordToEncoding opts a), fst (recordToEncoding opts b)]
1074+ ) => RecordToPairs enc pairs arity (a :*: b)
734− , Nothing)
1075+ where
735− recordToEncoding opts (a :*: b) =
1076+ recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
736− (fst (recordToEncoding opts a) <> E.comma <>
1077+ pairsOf a `mappend` pairsOf b
737− fst (recordToEncoding opts b),
1078+ where
738− Nothing)
1079+ pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
739−
1080+ pairsOf = recordToPairs opts targs
1081+ {-# INLINE recordToPairs #-}
740−instance (Selector s, GToEncoding a) => RecordToEncoding (S1 s a) where
1083+instance ( Selector s
741− recordToEncoding = fieldToEncoding
1084+ , GToJSON enc arity a
742−
1085+ , KeyValuePair enc pairs
1086+ ) => RecordToPairs enc pairs arity (S1 s a)
1088+ recordToPairs = fieldToPair
1089+ {-# INLINE recordToPairs #-}
1091+instance INCOHERENT_
743−instance OVERLAPPING_ (Selector s, ToJSON a) =>
1092+ ( Selector s
744− RecordToEncoding (S1 s (K1 i (Maybe a))) where
1093+ , GToJSON enc arity (K1 i (Maybe a))
1094+ , KeyValuePair enc pairs
1096+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
745− recordToEncoding opts (M1 k1) | omitNothingFields opts
1098+ recordToPairs opts _ (M1 k1) | omitNothingFields opts
746− , K1 Nothing <- k1 = (mempty, Nothing)
1099+ , K1 Nothing <- k1 = mempty
747− recordToEncoding opts m1 = fieldToEncoding opts m1
1100+ recordToPairs opts targs m1 = fieldToPair opts targs m1
748−
1101+ {-# INLINE recordToPairs #-}
749−fieldToEncoding :: (Selector s, GToEncoding a) => Options -> S1 s a p -> (Encoding, Maybe Encoding)
1102+
750−fieldToEncoding opts m1 =
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
1117+ , GToJSON enc arity a
1118+ , KeyValuePair enc pairs)
1119+ => Options -> ToArgs enc arity p
1120+ -> S1 s a p -> pairs
1121+fieldToPair opts targs m1 =
751− let keyBuilder = toEncoding (fieldLabelModifier opts $ selName m1)
1122+ let key = fieldLabelModifier opts (selName m1)
752− valueBuilder = gToEncoding opts (unM1 m1)
1123+ value = gToJSON opts targs (unM1 m1)
753− in (keyBuilder <> E.colon <> valueBuilder, Just valueBuilder)
1124+ in key `pair` value
1125+{-# INLINE fieldToPair #-}
755--------------------------------------------------------------------------------
1127--------------------------------------------------------------------------------
757−class WriteProduct f where
1129+class WriteProduct arity f where
758 writeProduct :: Options
1130 writeProduct :: Options
1131+ -> ToArgs Value arity a
759 -> VM.MVector s Value
1132 -> VM.MVector s Value
760 -> Int -- ^ index
1133 -> Int -- ^ index
761 -> Int -- ^ length
1134 -> Int -- ^ length
763 -> ST s ()
1136 -> ST s ()
765−instance ( WriteProduct a
1138+instance ( WriteProduct arity a
766− , WriteProduct b ) => WriteProduct (a :*: b) where
1139+ , WriteProduct arity b
767− writeProduct opts mv ix len (a :*: b) = do
1140+ ) => WriteProduct arity (a :*: b) where
768− writeProduct opts mv ix lenL a
1141+ writeProduct opts targs mv ix len (a :*: b) = do
769− writeProduct opts mv ixR lenR b
1142+ writeProduct opts targs mv ix lenL a
1143+ writeProduct opts targs mv ixR lenR b
771 lenL = len `unsafeShiftR` 1
1145 lenL = len `unsafeShiftR` 1
772 lenR = len - lenL
1146 lenR = len - lenL
773 ixR = ix + lenL
1147 ixR = ix + lenL
1148+ {-# INLINE writeProduct #-}
775−instance OVERLAPPABLE_ (GToJSON a) => WriteProduct a where
1150+instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
776− writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
1151+ writeProduct opts targs mv ix _ =
1152+ VM.unsafeWrite mv ix . gToJSON opts targs
1153+ {-# INLINE writeProduct #-}
778--------------------------------------------------------------------------------
1155--------------------------------------------------------------------------------
780−class EncodeProduct f where
1157+class EncodeProduct arity f where
781− encodeProduct :: Options -> f a -> Encoding
1158+ encodeProduct :: Options -> ToArgs Encoding arity a
1159+ -> f a -> Encoding' E.InArray
783−instance ( EncodeProduct a
1161+instance ( EncodeProduct arity a
784− , EncodeProduct b ) => EncodeProduct (a :*: b) where
1162+ , EncodeProduct arity b
785− encodeProduct opts (a :*: b) | omitNothingFields opts =
1163+ ) => EncodeProduct arity (a :*: b) where
786− mconcat $ intersperse E.comma $
1164+ encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1165+ E.econcat $ intersperse E.comma $
787 filter (not . E.nullEncoding)
1166 filter (not . E.nullEncoding)
788− [encodeProduct opts a, encodeProduct opts b]
1167+ [encodeProduct opts targs a, encodeProduct opts targs b]
789− encodeProduct opts (a :*: b) = encodeProduct opts a <>
1168+ encodeProduct opts targs (a :*: b) =
790− E.comma <>
1169+ encodeProduct opts targs a >*<
791− encodeProduct opts b
1170+ encodeProduct opts targs b
1171+ {-# INLINE encodeProduct #-}
793−instance OVERLAPPABLE_ (GToEncoding a) => EncodeProduct a where
1173+instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
794− encodeProduct opts = gToEncoding opts
1174+ encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1175+ {-# INLINE encodeProduct #-}
796--------------------------------------------------------------------------------
1177--------------------------------------------------------------------------------
798−class ObjectWithSingleFieldObj f where
1179+instance ( GToJSON enc arity a
799− objectWithSingleFieldObj :: Options -> f a -> Object
1180+ , ConsToJSON enc arity a
800−
1181+ , FromPairs enc pairs
801−instance ( ObjectWithSingleFieldObj a
1182+ , KeyValuePair enc pairs
802− , ObjectWithSingleFieldObj b ) => ObjectWithSingleFieldObj (a :+: b) where
1183+ , Constructor c
803− objectWithSingleFieldObj opts (L1 x) = objectWithSingleFieldObj opts x
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
804− objectWithSingleFieldObj opts (R1 x) = objectWithSingleFieldObj opts x
1185+ where
805−
1186+ sumToJSON' opts targs =
806−instance ( GToJSON a, ConsToJSON a
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
807− , Constructor c ) => ObjectWithSingleFieldObj (C1 c a) where
808− objectWithSingleFieldObj opts = H.singleton typ . gToJSON opts
810− typ = pack $ constructorTagModifier opts $
1189+ typ = constructorTagModifier opts $
811 conName (undefined :: t c a p)
1190 conName (undefined :: t c a p)
813--------------------------------------------------------------------------------
1192--------------------------------------------------------------------------------
815−class ObjectWithSingleFieldEnc f where
1194+instance OVERLAPPABLE_
816− objectWithSingleFieldEnc :: Options -> f a -> Encoding
1195+ ( ConsToJSON enc arity a
817−
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
818−instance ( ObjectWithSingleFieldEnc a
1197+ where
819− , ObjectWithSingleFieldEnc b ) => ObjectWithSingleFieldEnc (a :+: b) where
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
820− objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x
1199+
821− objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x
1200+instance OVERLAPPING_
822−
1201+ ( Constructor c
823−instance ( GToEncoding a, ConsToEncoding a
1202+ , FromString enc
824− , Constructor c ) => ObjectWithSingleFieldEnc (C1 c a) where
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
825− objectWithSingleFieldEnc opts v =
1204+ where
826− E.openCurly <>
1205+ sumToJSON' opts _ _ = Tagged . fromString $
827− toEncoding
1206+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
828− (constructorTagModifier opts
829− (conName (undefined :: t c a p))) <>
831− gToEncoding opts v <>
834-------------------------------------------------------------------------------
1208-------------------------------------------------------------------------------
835-- Instances
1209-- Instances
836-------------------------------------------------------------------------------
1210-------------------------------------------------------------------------------
840-------------------------------------------------------------------------------
1212-------------------------------------------------------------------------------
842-------------------------------------------------------------------------------
1214-------------------------------------------------------------------------------
844−instance ToJSON1 Identity where
845− liftToJSON t _ (Identity a) = t a
846− {-# INLINE liftToJSON #-}
848− liftToEncoding t _ (Identity a) = t a
849− {-# INLINE liftToEncoding #-}
851−instance (ToJSON a) => ToJSON (Identity a) where
853− {-# INLINE toJSON #-}
855− toEncoding = toEncoding1
856− {-# INLINE toEncoding #-}
859instance ToJSON2 Const where
1216instance ToJSON2 Const where
860 liftToJSON2 t _ _ _ (Const x) = t x
1217 liftToJSON2 t _ _ _ (Const x) = t x
861 {-# INLINE liftToJSON2 #-}
1218 {-# INLINE liftToJSON2 #-}
@@ -884,7 +1241,7 @@ instance ToJSON1 Maybe where
884 {-# INLINE liftToJSON #-}
1241 {-# INLINE liftToJSON #-}
886 liftToEncoding t _ (Just a) = t a
1243 liftToEncoding t _ (Just a) = t a
887− liftToEncoding _ _ Nothing = Encoding EB.null_
1244+ liftToEncoding _ _ Nothing = E.null_
888 {-# INLINE liftToEncoding #-}
1245 {-# INLINE liftToEncoding #-}
890instance (ToJSON a) => ToJSON (Maybe a) where
1247instance (ToJSON a) => ToJSON (Maybe a) where
@@ -896,19 +1253,13 @@ instance (ToJSON a) => ToJSON (Maybe a) where
898instance ToJSON2 Either where
1255instance ToJSON2 Either where
899− liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton left (toA a)
1256+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
900− liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton right (toB b)
1257+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
901 {-# INLINE liftToJSON2 #-}
1258 {-# INLINE liftToJSON2 #-}
903− liftToEncoding2 toA _ _toB _ (Left a) =
1260+ liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
904− Encoding (B.shortByteString "{\"Left\":")
906− <> Encoding (B.char7 '}')
908− liftToEncoding2 _toA _ toB _ (Right b) =
1262+ liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b
909− Encoding (B.shortByteString "{\"Right\":")
911− <> Encoding (B.char7 '}')
912 {-# INLINE liftToEncoding2 #-}
1263 {-# INLINE liftToEncoding2 #-}
914instance (ToJSON a) => ToJSON1 (Either a) where
1265instance (ToJSON a) => ToJSON1 (Either a) where
@@ -925,18 +1276,24 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
925 toEncoding = toEncoding2
1276 toEncoding = toEncoding2
926 {-# INLINE toEncoding #-}
1277 {-# INLINE toEncoding #-}
928−left, right :: Text
1279+instance ToJSON Void where
929−left = "Left"
1280+ toJSON = absurd
930−right = "Right"
1281+ {-# INLINE toJSON #-}
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
933instance ToJSON Bool where
1287instance ToJSON Bool where
934 toJSON = Bool
1288 toJSON = Bool
935 {-# INLINE toJSON #-}
1289 {-# INLINE toJSON #-}
937− toEncoding = Encoding . EB.bool
1291+ toEncoding = E.bool
938 {-# INLINE toEncoding #-}
1292 {-# INLINE toEncoding #-}
1294+instance ToJSONKey Bool where
1295+ toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
941instance ToJSON Ordering where
1298instance ToJSON Ordering where
942 toJSON = toJSON . orderingToText
1299 toJSON = toJSON . orderingToText
@@ -963,10 +1320,10 @@ instance ToJSON Char where
963 toJSONList = String . T.pack
1320 toJSONList = String . T.pack
964 {-# INLINE toJSONList #-}
1321 {-# INLINE toJSONList #-}
966− toEncoding = Encoding . EB.string . (:[])
1323+ toEncoding = E.string . (:[])
967 {-# INLINE toEncoding #-}
1324 {-# INLINE toEncoding #-}
969− toEncodingList = Encoding . EB.string
1326+ toEncodingList = E.string
970 {-# INLINE toEncodingList #-}
1327 {-# INLINE toEncodingList #-}
@@ -974,9 +1331,13 @@ instance ToJSON Double where
974 toJSON = realFloatToJSON
1331 toJSON = realFloatToJSON
975 {-# INLINE toJSON #-}
1332 {-# INLINE toJSON #-}
977− toEncoding = realFloatToEncoding
1334+ toEncoding = E.double
978 {-# INLINE toEncoding #-}
1335 {-# INLINE toEncoding #-}
1337+instance ToJSONKey Double where
1338+ toJSONKey = toJSONKeyTextEnc E.doubleText
1339+ {-# INLINE toJSONKey #-}
981instance ToJSON Number where
1342instance ToJSON Number where
982 toJSON (D d) = toJSON d
1343 toJSON (D d) = toJSON d
@@ -992,20 +1353,23 @@ instance ToJSON Float where
992 toJSON = realFloatToJSON
1353 toJSON = realFloatToJSON
993 {-# INLINE toJSON #-}
1354 {-# INLINE toJSON #-}
995− toEncoding = realFloatToEncoding
1356+ toEncoding = E.float
996 {-# INLINE toEncoding #-}
1357 {-# INLINE toEncoding #-}
1359+instance ToJSONKey Float where
1360+ toJSONKey = toJSONKeyTextEnc E.floatText
1361+ {-# INLINE toJSONKey #-}
999−instance ToJSON (Ratio Integer) where
1364+instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
1000 toJSON r = object [ "numerator" .= numerator r
1365 toJSON r = object [ "numerator" .= numerator r
1001 , "denominator" .= denominator r
1366 , "denominator" .= denominator r
1003 {-# INLINE toJSON #-}
1368 {-# INLINE toJSON #-}
1005− toEncoding r = Encoding $
1370+ toEncoding r = E.pairs $
1006− B.shortByteString "{\"numerator\":" <> builder (numerator r) <>
1371+ "numerator" .= numerator r <>
1007− B.shortByteString ",\"denominator\":" <> builder (denominator r) <>
1372+ "denominator" .= denominator r
1009 {-# INLINE toEncoding #-}
1373 {-# INLINE toEncoding #-}
@@ -1013,24 +1377,37 @@ instance HasResolution a => ToJSON (Fixed a) where
1013 toJSON = Number . realToFrac
1377 toJSON = Number . realToFrac
1014 {-# INLINE toJSON #-}
1378 {-# INLINE toJSON #-}
1016− toEncoding = Encoding . EB.number . realToFrac
1380+ toEncoding = E.scientific . realToFrac
1017 {-# INLINE toEncoding #-}
1381 {-# INLINE toEncoding #-}
1383+instance HasResolution a => ToJSONKey (Fixed a) where
1384+ toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)
1385+ {-# INLINE toJSONKey #-}
1020instance ToJSON Int where
1388instance ToJSON Int where
1021 toJSON = Number . fromIntegral
1389 toJSON = Number . fromIntegral
1022 {-# INLINE toJSON #-}
1390 {-# INLINE toJSON #-}
1024− toEncoding = Encoding . B.intDec
1392+ toEncoding = E.int
1025 {-# INLINE toEncoding #-}
1393 {-# INLINE toEncoding #-}
1395+instance ToJSONKey Int where
1396+ toJSONKey = toJSONKeyTextEnc E.intText
1397+ {-# INLINE toJSONKey #-}
1027instance ToJSON Integer where
1400instance ToJSON Integer where
1028 toJSON = Number . fromInteger
1401 toJSON = Number . fromInteger
1029 {-# INLINE toJSON #-}
1402 {-# INLINE toJSON #-}
1031− toEncoding = Encoding . B.integerDec
1404+ toEncoding = E.integer
1032 {-# INLINE toEncoding #-}
1405 {-# INLINE toEncoding #-}
1407+instance ToJSONKey Integer where
1408+ toJSONKey = toJSONKeyTextEnc E.integerText
1409+ {-# INLINE toJSONKey #-}
1035instance ToJSON Natural where
1412instance ToJSON Natural where
1036 toJSON = toJSON . toInteger
1413 toJSON = toJSON . toInteger
@@ -1039,93 +1416,147 @@ instance ToJSON Natural where
1039 toEncoding = toEncoding . toInteger
1416 toEncoding = toEncoding . toInteger
1040 {-# INLINE toEncoding #-}
1417 {-# INLINE toEncoding #-}
1419+instance ToJSONKey Natural where
1420+ toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)
1421+ {-# INLINE toJSONKey #-}
1043instance ToJSON Int8 where
1424instance ToJSON Int8 where
1044 toJSON = Number . fromIntegral
1425 toJSON = Number . fromIntegral
1045 {-# INLINE toJSON #-}
1426 {-# INLINE toJSON #-}
1047− toEncoding = Encoding . B.int8Dec
1428+ toEncoding = E.int8
1048 {-# INLINE toEncoding #-}
1429 {-# INLINE toEncoding #-}
1431+instance ToJSONKey Int8 where
1432+ toJSONKey = toJSONKeyTextEnc E.int8Text
1433+ {-# INLINE toJSONKey #-}
1051instance ToJSON Int16 where
1436instance ToJSON Int16 where
1052 toJSON = Number . fromIntegral
1437 toJSON = Number . fromIntegral
1053 {-# INLINE toJSON #-}
1438 {-# INLINE toJSON #-}
1055− toEncoding = Encoding . B.int16Dec
1440+ toEncoding = E.int16
1056 {-# INLINE toEncoding #-}
1441 {-# INLINE toEncoding #-}
1443+instance ToJSONKey Int16 where
1444+ toJSONKey = toJSONKeyTextEnc E.int16Text
1445+ {-# INLINE toJSONKey #-}
1059instance ToJSON Int32 where
1448instance ToJSON Int32 where
1060 toJSON = Number . fromIntegral
1449 toJSON = Number . fromIntegral
1061 {-# INLINE toJSON #-}
1450 {-# INLINE toJSON #-}
1063− toEncoding = Encoding . B.int32Dec
1452+ toEncoding = E.int32
1064 {-# INLINE toEncoding #-}
1453 {-# INLINE toEncoding #-}
1455+instance ToJSONKey Int32 where
1456+ toJSONKey = toJSONKeyTextEnc E.int32Text
1457+ {-# INLINE toJSONKey #-}
1067instance ToJSON Int64 where
1460instance ToJSON Int64 where
1068 toJSON = Number . fromIntegral
1461 toJSON = Number . fromIntegral
1069 {-# INLINE toJSON #-}
1462 {-# INLINE toJSON #-}
1071− toEncoding = Encoding . B.int64Dec
1464+ toEncoding = E.int64
1072 {-# INLINE toEncoding #-}
1465 {-# INLINE toEncoding #-}
1467+instance ToJSONKey Int64 where
1468+ toJSONKey = toJSONKeyTextEnc E.int64Text
1469+ {-# INLINE toJSONKey #-}
1075instance ToJSON Word where
1471instance ToJSON Word where
1076 toJSON = Number . fromIntegral
1472 toJSON = Number . fromIntegral
1077 {-# INLINE toJSON #-}
1473 {-# INLINE toJSON #-}
1079− toEncoding = Encoding . B.wordDec
1475+ toEncoding = E.word
1080 {-# INLINE toEncoding #-}
1476 {-# INLINE toEncoding #-}
1478+instance ToJSONKey Word where
1479+ toJSONKey = toJSONKeyTextEnc E.wordText
1480+ {-# INLINE toJSONKey #-}
1083instance ToJSON Word8 where
1483instance ToJSON Word8 where
1084 toJSON = Number . fromIntegral
1484 toJSON = Number . fromIntegral
1085 {-# INLINE toJSON #-}
1485 {-# INLINE toJSON #-}
1087− toEncoding = Encoding . B.word8Dec
1487+ toEncoding = E.word8
1088 {-# INLINE toEncoding #-}
1488 {-# INLINE toEncoding #-}
1490+instance ToJSONKey Word8 where
1491+ toJSONKey = toJSONKeyTextEnc E.word8Text
1492+ {-# INLINE toJSONKey #-}
1091instance ToJSON Word16 where
1495instance ToJSON Word16 where
1092 toJSON = Number . fromIntegral
1496 toJSON = Number . fromIntegral
1093 {-# INLINE toJSON #-}
1497 {-# INLINE toJSON #-}
1095− toEncoding = Encoding . B.word16Dec
1499+ toEncoding = E.word16
1096 {-# INLINE toEncoding #-}
1500 {-# INLINE toEncoding #-}
1502+instance ToJSONKey Word16 where
1503+ toJSONKey = toJSONKeyTextEnc E.word16Text
1504+ {-# INLINE toJSONKey #-}
1099instance ToJSON Word32 where
1507instance ToJSON Word32 where
1100 toJSON = Number . fromIntegral
1508 toJSON = Number . fromIntegral
1101 {-# INLINE toJSON #-}
1509 {-# INLINE toJSON #-}
1103− toEncoding = Encoding . B.word32Dec
1511+ toEncoding = E.word32
1104 {-# INLINE toEncoding #-}
1512 {-# INLINE toEncoding #-}
1514+instance ToJSONKey Word32 where
1515+ toJSONKey = toJSONKeyTextEnc E.word32Text
1516+ {-# INLINE toJSONKey #-}
1106instance ToJSON Word64 where
1519instance ToJSON Word64 where
1107 toJSON = Number . fromIntegral
1520 toJSON = Number . fromIntegral
1108 {-# INLINE toJSON #-}
1521 {-# INLINE toJSON #-}
1110− toEncoding = Encoding . B.word64Dec
1523+ toEncoding = E.word64
1524+ {-# INLINE toEncoding #-}
1526+instance ToJSONKey Word64 where
1527+ toJSONKey = toJSONKeyTextEnc E.word64Text
1528+ {-# INLINE toJSONKey #-}
1530+instance ToJSON CTime where
1531+ toJSON (CTime i) = toJSON i
1532+ {-# INLINE toJSON #-}
1534+ toEncoding (CTime i) = toEncoding i
1111 {-# INLINE toEncoding #-}
1535 {-# INLINE toEncoding #-}
1113instance ToJSON Text where
1537instance ToJSON Text where
1114 toJSON = String
1538 toJSON = String
1115 {-# INLINE toJSON #-}
1539 {-# INLINE toJSON #-}
1117− toEncoding = Encoding . EB.text
1541+ toEncoding = E.text
1118 {-# INLINE toEncoding #-}
1542 {-# INLINE toEncoding #-}
1544+instance ToJSONKey Text where
1545+ toJSONKey = toJSONKeyText id
1546+ {-# INLINE toJSONKey #-}
1120instance ToJSON LT.Text where
1549instance ToJSON LT.Text where
1121 toJSON = String . LT.toStrict
1550 toJSON = String . LT.toStrict
1122 {-# INLINE toJSON #-}
1551 {-# INLINE toJSON #-}
1124− toEncoding t = Encoding $
1553+ toEncoding = E.lazyText
1126− LT.foldrChunks (\x xs -> EB.unquoted x <> xs) (B.char7 '"') t
1127 {-# INLINE toEncoding #-}
1554 {-# INLINE toEncoding #-}
1556+instance ToJSONKey LT.Text where
1557+ toJSONKey = toJSONKeyText LT.toStrict
1129instance ToJSON Version where
1560instance ToJSON Version where
1130 toJSON = toJSON . showVersion
1561 toJSON = toJSON . showVersion
1131 {-# INLINE toJSON #-}
1562 {-# INLINE toJSON #-}
@@ -1133,6 +1564,8 @@ instance ToJSON Version where
1133 toEncoding = toEncoding . showVersion
1564 toEncoding = toEncoding . showVersion
1134 {-# INLINE toEncoding #-}
1565 {-# INLINE toEncoding #-}
1567+instance ToJSONKey Version where
1568+ toJSONKey = toJSONKeyText (T.pack . showVersion)
1137-------------------------------------------------------------------------------
1570-------------------------------------------------------------------------------
1138-- semigroups NonEmpty
1571-- semigroups NonEmpty
@@ -1160,7 +1593,138 @@ instance ToJSON Scientific where
1160 toJSON = Number
1593 toJSON = Number
1161 {-# INLINE toJSON #-}
1594 {-# INLINE toJSON #-}
1163− toEncoding = Encoding . EB.number
1596+ toEncoding = E.scientific
1597+ {-# INLINE toEncoding #-}
1599+instance ToJSONKey Scientific where
1600+ toJSONKey = toJSONKeyTextEnc E.scientificText
1602+-------------------------------------------------------------------------------
1604+-------------------------------------------------------------------------------
1606+instance ToJSON1 DList.DList where
1607+ liftToJSON t _ = listValue t . toList
1608+ {-# INLINE liftToJSON #-}
1610+ liftToEncoding t _ = listEncoding t . toList
1611+ {-# INLINE liftToEncoding #-}
1613+instance (ToJSON a) => ToJSON (DList.DList a) where
1615+ {-# INLINE toJSON #-}
1617+ toEncoding = toEncoding1
1618+ {-# INLINE toEncoding #-}
1620+-------------------------------------------------------------------------------
1621+-- transformers - Functors
1622+-------------------------------------------------------------------------------
1624+instance ToJSON1 Identity where
1625+ liftToJSON t _ (Identity a) = t a
1626+ {-# INLINE liftToJSON #-}
1628+ liftToJSONList _ tl xs = tl (map runIdentity xs)
1629+ {-# INLINE liftToJSONList #-}
1631+ liftToEncoding t _ (Identity a) = t a
1632+ {-# INLINE liftToEncoding #-}
1634+ liftToEncodingList _ tl xs = tl (map runIdentity xs)
1635+ {-# INLINE liftToEncodingList #-}
1637+instance (ToJSON a) => ToJSON (Identity a) where
1639+ {-# INLINE toJSON #-}
1641+ toJSONList = liftToJSONList toJSON toJSONList
1642+ {-# INLINE toJSONList #-}
1644+ toEncoding = toEncoding1
1645+ {-# INLINE toEncoding #-}
1647+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1648+ {-# INLINE toEncodingList #-}
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
1651+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652+ toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1655+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1656+ liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1658+ g = liftToJSON tv tvl
1659+ gl = liftToJSONList tv tvl
1660+ {-# INLINE liftToJSON #-}
1662+ liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1664+ g = liftToJSON te tel
1665+ gl = liftToJSONList te tel
1666+ {-# INLINE liftToJSONList #-}
1668+ liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1670+ g = liftToEncoding te tel
1671+ gl = liftToEncodingList te tel
1672+ {-# INLINE liftToEncoding #-}
1674+ liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1676+ g = liftToEncoding te tel
1677+ gl = liftToEncodingList te tel
1678+ {-# INLINE liftToEncodingList #-}
1680+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1682+ {-# INLINE toJSON #-}
1684+ toJSONList = liftToJSONList toJSON toJSONList
1685+ {-# INLINE toJSONList #-}
1687+ toEncoding = toEncoding1
1688+ {-# INLINE toEncoding #-}
1690+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1691+ {-# INLINE toEncodingList #-}
1694+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where
1695+ liftToJSON tv tvl (Pair x y) = liftToJSON2 tx txl ty tyl (x, y)
1697+ tx = liftToJSON tv tvl
1698+ txl = liftToJSONList tv tvl
1699+ ty = liftToJSON tv tvl
1700+ tyl = liftToJSONList tv tvl
1702+ liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
1704+ tx = liftToEncoding te tel
1705+ txl = liftToEncodingList te tel
1706+ ty = liftToEncoding te tel
1707+ tyl = liftToEncodingList te tel
1709+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
1711+ {-# INLINE toJSON #-}
1713+ toEncoding = toEncoding1
1714+ {-# INLINE toEncoding #-}
1716+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where
1717+ liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)
1718+ liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)
1720+ liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x
1721+ liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y
1723+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
1725+ {-# INLINE toJSON #-}
1727+ toEncoding = toEncoding1
1164 {-# INLINE toEncoding #-}
1728 {-# INLINE toEncoding #-}
1166-------------------------------------------------------------------------------
1730-------------------------------------------------------------------------------
@@ -1228,17 +1792,15 @@ instance ToJSON a => ToJSON (IntMap.IntMap a) where
1229instance ToJSONKey k => ToJSON1 (M.Map k) where
1793instance ToJSONKey k => ToJSON1 (M.Map k) where
1230 liftToJSON g _ = case toJSONKey of
1794 liftToJSON g _ = case toJSONKey of
1231− ToJSONKeyText (f,_) -> Object . mapHashKeyVal f g
1795+ ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1232− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . M.toList
1796+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1233 {-# INLINE liftToJSON #-}
1797 {-# INLINE liftToJSON #-}
1235− -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> M.Map k a -> Encoding
1236 liftToEncoding g _ = case toJSONKey of
1799 liftToEncoding g _ = case toJSONKey of
1237− ToJSONKeyText (_,f) -> dict f g M.foldrWithKey
1800+ ToJSONKeyText _ f -> dict f g M.foldrWithKey
1238− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . M.toList
1801+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1240− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
1241− pairEncoding f (a, b) = tuple $ f a >*< g b
1242 {-# INLINE liftToEncoding #-}
1804 {-# INLINE liftToEncoding #-}
@@ -1276,6 +1838,17 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
1276 toEncoding = toEncoding1
1838 toEncoding = toEncoding1
1277 {-# INLINE toEncoding #-}
1839 {-# INLINE toEncoding #-}
1841+-------------------------------------------------------------------------------
1843+-------------------------------------------------------------------------------
1845+instance ToJSON UUID.UUID where
1846+ toJSON = toJSON . UUID.toText
1847+ toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1849+instance ToJSONKey UUID.UUID where
1850+ toJSONKey = ToJSONKeyText UUID.toText $
1851+ E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1280-------------------------------------------------------------------------------
1853-------------------------------------------------------------------------------
1281-- vector
1854-- vector
@@ -1285,29 +1858,20 @@ instance ToJSON1 Vector where
1285 liftToJSON t _ = Array . V.map t
1858 liftToJSON t _ = Array . V.map t
1286 {-# INLINE liftToJSON #-}
1859 {-# INLINE liftToJSON #-}
1288− liftToEncoding t _ xs
1861+ liftToEncoding t _ = listEncoding t . V.toList
1289− | V.null xs = emptyArray_
1290− | otherwise = Encoding $
1291− B.char7 '[' <> fromEncoding (t (V.unsafeHead xs)) <>
1292− V.foldr go (B.char7 ']') (V.unsafeTail xs)
1294− go v b = B.char7 ',' <> fromEncoding (t v) <> b
1295 {-# INLINE liftToEncoding #-}
1862 {-# INLINE liftToEncoding #-}
1297instance (ToJSON a) => ToJSON (Vector a) where
1864instance (ToJSON a) => ToJSON (Vector a) where
1298− toJSON = Array . V.map toJSON
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1299 {-# INLINE toJSON #-}
1868 {-# INLINE toJSON #-}
1301− toEncoding = encodeVector
1870+ toEncoding = toEncoding1
1302 {-# INLINE toEncoding #-}
1871 {-# INLINE toEncoding #-}
1304encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1873encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1305−encodeVector xs
1874+encodeVector = listEncoding toEncoding . VG.toList
1306− | VG.null xs = emptyArray_
1307− | otherwise = Encoding $
1308− B.char7 '[' <> builder (VG.unsafeHead xs) <>
1309− VG.foldr go (B.char7 ']') (VG.unsafeTail xs)
1310− where go v b = B.char7 ',' <> builder v <> b
1311{-# INLINE encodeVector #-}
1875{-# INLINE encodeVector #-}
1313vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
1877vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
@@ -1358,20 +1922,21 @@ instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
1359instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1923instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1360 liftToJSON g _ = case toJSONKey of
1924 liftToJSON g _ = case toJSONKey of
1361− ToJSONKeyText (f,_) -> Object . mapKeyVal f g
1925+ ToJSONKeyText f _ -> Object . mapKeyVal f g
1362− ToJSONKeyValue (f,_) -> Array . V.fromList . map (toJSONPair f g) . H.toList
1926+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
1363 {-# INLINE liftToJSON #-}
1927 {-# INLINE liftToJSON #-}
1365 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1929 -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1366 liftToEncoding g _ = case toJSONKey of
1930 liftToEncoding g _ = case toJSONKey of
1367− ToJSONKeyText (_,f) -> dict f g H.foldrWithKey
1931+ ToJSONKeyText _ f -> dict f g H.foldrWithKey
1368− ToJSONKeyValue (_,f) -> listEncoding (pairEncoding f) . H.toList
1932+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1370− -- pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
1371− pairEncoding f (a, b) = tuple $ f a >*< g b
1372 {-# INLINE liftToEncoding #-}
1935 {-# INLINE liftToEncoding #-}
1374instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1937instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938+ {-# SPECIALIZE instance ToJSON Object #-}
1375 toJSON = toJSON1
1940 toJSON = toJSON1
1376 {-# INLINE toJSON #-}
1941 {-# INLINE toJSON #-}
@@ -1386,7 +1951,7 @@ instance ToJSON Value where
1386 toJSON a = a
1951 toJSON a = a
1387 {-# INLINE toJSON #-}
1952 {-# INLINE toJSON #-}
1389− toEncoding = Encoding . EB.encodeToBuilder
1954+ toEncoding = E.value
1390 {-# INLINE toEncoding #-}
1955 {-# INLINE toEncoding #-}
1392instance ToJSON DotNetTime where
1957instance ToJSON DotNetTime where
@@ -1398,69 +1963,159 @@ dotNetTime :: DotNetTime -> String
1398dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1963dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1399 where secs = formatTime defaultTimeLocale "/Date(%s" t
1964 where secs = formatTime defaultTimeLocale "/Date(%s" t
1966+formatMillis :: (FormatTime t) => t -> String
1967+formatMillis = 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
1401-------------------------------------------------------------------------------
1995-------------------------------------------------------------------------------
1403-------------------------------------------------------------------------------
1997-------------------------------------------------------------------------------
1405instance ToJSON Day where
1999instance ToJSON Day where
1406− toJSON = stringEncoding
2000+ toJSON = stringEncoding . E.day
1407− toEncoding z = Encoding (EB.quote $ EB.day z)
2001+ toEncoding = E.day
2003+instance ToJSONKey Day where
2004+ toJSONKey = toJSONKeyTextEnc E.day
1410instance ToJSON TimeOfDay where
2007instance ToJSON TimeOfDay where
1411− toJSON = stringEncoding
2008+ toJSON = stringEncoding . E.timeOfDay
1412− toEncoding z = Encoding (EB.quote $ EB.timeOfDay z)
2009+ toEncoding = E.timeOfDay
2011+instance ToJSONKey TimeOfDay where
2012+ toJSONKey = toJSONKeyTextEnc E.timeOfDay
1415instance ToJSON LocalTime where
2015instance ToJSON LocalTime where
1416− toJSON = stringEncoding
2016+ toJSON = stringEncoding . E.localTime
1417− toEncoding z = Encoding (EB.quote $ EB.localTime z)
2017+ toEncoding = E.localTime
2019+instance ToJSONKey LocalTime where
2020+ toJSONKey = toJSONKeyTextEnc E.localTime
1419instance ToJSON ZonedTime where
2023instance ToJSON ZonedTime where
1420− toJSON = stringEncoding
2024+ toJSON = stringEncoding . E.zonedTime
2025+ toEncoding = E.zonedTime
1422− toEncoding z = Encoding (EB.quote $ EB.zonedTime z)
2027+instance ToJSONKey ZonedTime where
2028+ toJSONKey = toJSONKeyTextEnc E.zonedTime
1424−formatMillis :: (FormatTime t) => t -> String
1425−formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1427instance ToJSON UTCTime where
2031instance ToJSON UTCTime where
1428− toJSON = stringEncoding
2032+ toJSON = stringEncoding . E.utcTime
2033+ toEncoding = E.utcTime
1430− toEncoding t = Encoding (EB.quote $ EB.utcTime t)
2035+instance ToJSONKey UTCTime where
2036+ toJSONKey = toJSONKeyTextEnc E.utcTime
1432-- | Encode something t a JSON string.
2038-- | Encode something t a JSON string.
1433−--
2039+stringEncoding :: Encoding' Text -> Value
1434−-- TODO: remove me, this is a hack
1435−stringEncoding :: (ToJSON a) => a -> Value
1436stringEncoding = String
2040stringEncoding = String
1437 . T.dropAround (== '"')
2041 . T.dropAround (== '"')
1438 . T.decodeLatin1
2042 . T.decodeLatin1
1439 . L.toStrict
2043 . L.toStrict
1440− . B.toLazyByteString
2044+ . E.encodingToLazyByteString
1443{-# INLINE stringEncoding #-}
2045{-# INLINE stringEncoding #-}
1445instance ToJSON NominalDiffTime where
2048instance ToJSON NominalDiffTime where
1446 toJSON = Number . realToFrac
2049 toJSON = Number . realToFrac
1447 {-# INLINE toJSON #-}
2050 {-# INLINE toJSON #-}
1449− toEncoding = Encoding . EB.number . realToFrac
2052+ toEncoding = E.scientific . realToFrac
1450 {-# INLINE toEncoding #-}
2053 {-# INLINE toEncoding #-}
2056+instance ToJSON DiffTime where
2057+ toJSON = Number . realToFrac
2058+ {-# INLINE toJSON #-}
2060+ toEncoding = E.scientific . realToFrac
2061+ {-# INLINE toEncoding #-}
2063+-- | Encoded as number
2064+instance ToJSON SystemTime where
2065+ toJSON (MkSystemTime secs nsecs) =
2066+ toJSON (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2067+ toEncoding (MkSystemTime secs nsecs) =
2068+ toEncoding (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2070+instance ToJSON CalendarDiffTime where
2071+ toJSON (CalendarDiffTime m nt) = object
2075+ toEncoding (CalendarDiffTime m nt) = E.pairs
2076+ ("months" .= m <> "time" .= nt)
2078+instance ToJSON CalendarDiffDays where
2079+ toJSON (CalendarDiffDays m d) = object
2083+ toEncoding (CalendarDiffDays m d) = E.pairs
2084+ ("months" .= m <> "days" .= d)
2086+instance ToJSON DayOfWeek where
2087+ toJSON Monday = "monday"
2088+ toJSON Tuesday = "tuesday"
2089+ toJSON Wednesday = "wednesday"
2090+ toJSON Thursday = "thursday"
2091+ toJSON Friday = "friday"
2092+ toJSON Saturday = "saturday"
2093+ toJSON Sunday = "sunday"
2095+toEncodingDayOfWeek :: DayOfWeek -> E.Encoding' Text
2096+toEncodingDayOfWeek Monday = E.unsafeToEncoding "\"monday\""
2097+toEncodingDayOfWeek Tuesday = E.unsafeToEncoding "\"tuesday\""
2098+toEncodingDayOfWeek Wednesday = E.unsafeToEncoding "\"wednesday\""
2099+toEncodingDayOfWeek Thursday = E.unsafeToEncoding "\"thursday\""
2100+toEncodingDayOfWeek Friday = E.unsafeToEncoding "\"friday\""
2101+toEncodingDayOfWeek Saturday = E.unsafeToEncoding "\"saturday\""
2102+toEncodingDayOfWeek Sunday = E.unsafeToEncoding "\"sunday\""
2104+instance ToJSONKey DayOfWeek where
2105+ toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek
1452-------------------------------------------------------------------------------
2107-------------------------------------------------------------------------------
1453-- base Monoid/Semigroup
2108-- base Monoid/Semigroup
1454-------------------------------------------------------------------------------
2109-------------------------------------------------------------------------------
1456−instance ToJSON1 Dual where
2111+instance ToJSON1 Monoid.Dual where
1457− liftToJSON t _ = t . getDual
2112+ liftToJSON t _ = t . Monoid.getDual
1458 {-# INLINE liftToJSON #-}
2113 {-# INLINE liftToJSON #-}
1460− liftToEncoding t _ = t . getDual
2115+ liftToEncoding t _ = t . Monoid.getDual
1461 {-# INLINE liftToEncoding #-}
2116 {-# INLINE liftToEncoding #-}
1463−instance ToJSON a => ToJSON (Dual a) where
2118+instance ToJSON a => ToJSON (Monoid.Dual a) where
1464 toJSON = toJSON1
2119 toJSON = toJSON1
1465 {-# INLINE toJSON #-}
2120 {-# INLINE toJSON #-}
@@ -1468,14 +2123,14 @@ instance ToJSON a => ToJSON (Dual a) where
1468 {-# INLINE toEncoding #-}
2123 {-# INLINE toEncoding #-}
1471−instance ToJSON1 First where
2126+instance ToJSON1 Monoid.First where
1472− liftToJSON t to' = liftToJSON t to' . getFirst
2127+ liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
1473 {-# INLINE liftToJSON #-}
2128 {-# INLINE liftToJSON #-}
1475− liftToEncoding t to' = liftToEncoding t to' . getFirst
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
1476 {-# INLINE liftToEncoding #-}
2131 {-# INLINE liftToEncoding #-}
1478−instance ToJSON a => ToJSON (First a) where
2133+instance ToJSON a => ToJSON (Monoid.First a) where
1479 toJSON = toJSON1
2134 toJSON = toJSON1
1480 {-# INLINE toJSON #-}
2135 {-# INLINE toJSON #-}
@@ -1483,14 +2138,103 @@ instance ToJSON a => ToJSON (First a) where
1483 {-# INLINE toEncoding #-}
2138 {-# INLINE toEncoding #-}
1486−instance ToJSON1 Last where
2141+instance ToJSON1 Monoid.Last where
1487− liftToJSON t to' = liftToJSON t to' . getLast
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
1488 {-# INLINE liftToJSON #-}
2143 {-# INLINE liftToJSON #-}
1490− liftToEncoding t to' = liftToEncoding t to' . getLast
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
1491 {-# INLINE liftToEncoding #-}
2146 {-# INLINE liftToEncoding #-}
1493−instance ToJSON a => ToJSON (Last a) where
2148+instance ToJSON a => ToJSON (Monoid.Last a) where
2150+ {-# INLINE toJSON #-}
2152+ toEncoding = toEncoding1
2153+ {-# INLINE toEncoding #-}
2156+instance ToJSON1 Semigroup.Min where
2157+ liftToJSON t _ (Semigroup.Min x) = t x
2158+ {-# INLINE liftToJSON #-}
2160+ liftToEncoding t _ (Semigroup.Min x) = t x
2161+ {-# INLINE liftToEncoding #-}
2163+instance ToJSON a => ToJSON (Semigroup.Min a) where
2165+ {-# INLINE toJSON #-}
2167+ toEncoding = toEncoding1
2168+ {-# INLINE toEncoding #-}
2171+instance ToJSON1 Semigroup.Max where
2172+ liftToJSON t _ (Semigroup.Max x) = t x
2173+ {-# INLINE liftToJSON #-}
2175+ liftToEncoding t _ (Semigroup.Max x) = t x
2176+ {-# INLINE liftToEncoding #-}
2178+instance ToJSON a => ToJSON (Semigroup.Max a) where
2180+ {-# INLINE toJSON #-}
2182+ toEncoding = toEncoding1
2183+ {-# INLINE toEncoding #-}
2185+instance ToJSON1 Semigroup.First where
2186+ liftToJSON t _ (Semigroup.First x) = t x
2187+ {-# INLINE liftToJSON #-}
2189+ liftToEncoding t _ (Semigroup.First x) = t x
2190+ {-# INLINE liftToEncoding #-}
2192+instance ToJSON a => ToJSON (Semigroup.First a) where
2194+ {-# INLINE toJSON #-}
2196+ toEncoding = toEncoding1
2197+ {-# INLINE toEncoding #-}
2200+instance ToJSON1 Semigroup.Last where
2201+ liftToJSON t _ (Semigroup.Last x) = t x
2202+ {-# INLINE liftToJSON #-}
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
1494 toJSON = toJSON1
2238 toJSON = toJSON1
1495 {-# INLINE toJSON #-}
2239 {-# INLINE toJSON #-}
@@ -1501,14 +2245,28 @@ instance ToJSON a => ToJSON (Last a) where
1501-- tagged
2245-- tagged
1502-------------------------------------------------------------------------------
2246-------------------------------------------------------------------------------
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
1504instance ToJSON (Proxy a) where
2255instance ToJSON (Proxy a) where
1505 toJSON _ = Null
2256 toJSON _ = Null
1506 {-# INLINE toJSON #-}
2257 {-# INLINE toJSON #-}
1508− toEncoding _ = Encoding EB.null_
2259+ toEncoding _ = E.null_
1509 {-# INLINE toEncoding #-}
2260 {-# INLINE toEncoding #-}
2263+instance ToJSON2 Tagged where
2264+ liftToJSON2 _ _ t _ (Tagged x) = t x
2265+ {-# INLINE liftToJSON2 #-}
2267+ liftToEncoding2 _ _ t _ (Tagged x) = t x
2268+ {-# INLINE liftToEncoding2 #-}
1512instance ToJSON1 (Tagged a) where
2270instance ToJSON1 (Tagged a) where
1513 liftToJSON t _ (Tagged x) = t x
2271 liftToJSON t _ (Tagged x) = t x
1514 {-# INLINE liftToJSON #-}
2272 {-# INLINE liftToJSON #-}
@@ -1523,7 +2281,6 @@ instance ToJSON b => ToJSON (Tagged a b) where
1523 toEncoding = toEncoding1
2281 toEncoding = toEncoding1
1524 {-# INLINE toEncoding #-}
2282 {-# INLINE toEncoding #-}
1527instance ToJSONKey b => ToJSONKey (Tagged a b) where
2284instance ToJSONKey b => ToJSONKey (Tagged a b) where
1528 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2285 toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
1529 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2286 toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
@@ -1532,41 +2289,22 @@ instance ToJSONKey b => ToJSONKey (Tagged a b) where
1532-- Instances for converting t map keys
2289-- Instances for converting t map keys
1533-------------------------------------------------------------------------------
2290-------------------------------------------------------------------------------
1535−instance ToJSONKey Text where
1536− toJSONKey = ToJSONKeyText (id,toEncoding)
1539−instance ToJSONKey Bool where
1540− toJSONKey = ToJSONKeyText
1541− ( (\x -> if x then "true" else "false")
1542− , (\x -> Encoding $ if x then "\"true\"" else "\"false\"")
1545−instance ToJSONKey Int where
1546− toJSONKey = ToJSONKeyText
1547− ( LT.toStrict . LTB.toLazyText . LTBI.decimal
1548− , \x -> Encoding $ B.char7 '"' <> fromEncoding (toEncoding x) <> B.char7 '"'
1551instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
2292instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
1552instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
2293instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
1553instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
2294instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
1555instance ToJSONKey Char where
2296instance ToJSONKey Char where
1556− toJSONKey = ToJSONKeyText (T.singleton, toEncoding)
2297+ toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
1557− toJSONKeyList = ToJSONKeyText (T.pack, toEncoding . T.pack)
2298+ toJSONKeyList = toJSONKeyText T.pack
1559instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2300instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
1560 toJSONKey = toJSONKeyList
2301 toJSONKey = toJSONKeyList
1562−instance (ToJSONKey a, ToJSON a) => ToJSONKey (Identity a) where
1563− toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1565-------------------------------------------------------------------------------
2303-------------------------------------------------------------------------------
1566−-- Tuple instances, see tuple-instances-to.hs
2304+-- Tuple instances
1567-------------------------------------------------------------------------------
2305-------------------------------------------------------------------------------
1569−instance ToJSON2 ((,) ) where
2307+instance ToJSON2 (,) where
1570 liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
2308 liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
1571 mv <- VM.unsafeNew 2
2309 mv <- VM.unsafeNew 2
1572 VM.unsafeWrite mv 0 (toA a)
2310 VM.unsafeWrite mv 0 (toA a)
@@ -1574,9 +2312,7 @@ instance ToJSON2 ((,) ) where
1574 return mv
2312 return mv
1575 {-# INLINE liftToJSON2 #-}
2313 {-# INLINE liftToJSON2 #-}
1577− liftToEncoding2 toA _ toB _ (a, b) = tuple $
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
1580 {-# INLINE liftToEncoding2 #-}
2316 {-# INLINE liftToEncoding2 #-}
1582instance (ToJSON a) => ToJSON1 ((,) a) where
2318instance (ToJSON a) => ToJSON1 ((,) a) where
@@ -1600,10 +2336,11 @@ instance (ToJSON a) => ToJSON2 ((,,) a) where
1600 return mv
2336 return mv
1601 {-# INLINE liftToJSON2 #-}
2337 {-# INLINE liftToJSON2 #-}
1603− liftToEncoding2 toB _ toC _ (a, b, c) = tuple $
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
1604− toEncoding a >*<
2340+ [ toEncoding a
1605− toB b >*<
2341+ , toB b
1607 {-# INLINE liftToEncoding2 #-}
2344 {-# INLINE liftToEncoding2 #-}
1609instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
2346instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
@@ -1628,11 +2365,12 @@ instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
1628 return mv
2365 return mv
1629 {-# INLINE liftToJSON2 #-}
2366 {-# INLINE liftToJSON2 #-}
1631− liftToEncoding2 toC _ toD _ (a, b, c, d) = tuple $
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
1632− toEncoding a >*<
2369+ [ toEncoding a
1633− toEncoding b >*<
2370+ , toEncoding b
1634− toC c >*<
2371+ , toC c
1636 {-# INLINE liftToEncoding2 #-}
2374 {-# INLINE liftToEncoding2 #-}
1638instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
2376instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
@@ -1658,12 +2396,13 @@ instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
1658 return mv
2396 return mv
1659 {-# INLINE liftToJSON2 #-}
2397 {-# INLINE liftToJSON2 #-}
1661− liftToEncoding2 toD _ toE _ (a, b, c, d, e) = tuple $
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
1662− toEncoding a >*<
2400+ [ toEncoding a
1663− toEncoding b >*<
2401+ , toEncoding b
1664− toEncoding c >*<
2402+ , toEncoding c
1665− toD d >*<
2403+ , toD d
1667 {-# INLINE liftToEncoding2 #-}
2406 {-# INLINE liftToEncoding2 #-}
1669instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
2408instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
@@ -1690,13 +2429,14 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) w
1690 return mv
2429 return mv
1691 {-# INLINE liftToJSON2 #-}
2430 {-# INLINE liftToJSON2 #-}
1693− liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = tuple $
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
1694− toEncoding a >*<
2433+ [ toEncoding a
1695− toEncoding b >*<
2434+ , toEncoding b
1696− toEncoding c >*<
2435+ , toEncoding c
1697− toEncoding d >*<
2436+ , toEncoding d
1698− toE e >*<
2437+ , toE e
1700 {-# INLINE liftToEncoding2 #-}
2440 {-# INLINE liftToEncoding2 #-}
1702instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
2442instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
@@ -1724,14 +2464,15 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,)
1724 return mv
2464 return mv
1725 {-# INLINE liftToJSON2 #-}
2465 {-# INLINE liftToJSON2 #-}
1727− liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = tuple $
2467+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
1728− toEncoding a >*<
2468+ [ toEncoding a
1729− toEncoding b >*<
2469+ , toEncoding b
1730− toEncoding c >*<
2470+ , toEncoding c
1731− toEncoding d >*<
2471+ , toEncoding d
1732− toEncoding e >*<
2472+ , toEncoding e
1733− toF f >*<
2473+ , toF f
1735 {-# INLINE liftToEncoding2 #-}
2476 {-# INLINE liftToEncoding2 #-}
1737instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
2478instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
@@ -1760,15 +2501,16 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2
1760 return mv
2501 return mv
1761 {-# INLINE liftToJSON2 #-}
2502 {-# INLINE liftToJSON2 #-}
1763− liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = tuple $
2504+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
1764− toEncoding a >*<
2505+ [ toEncoding a
1765− toEncoding b >*<
2506+ , toEncoding b
1766− toEncoding c >*<
2507+ , toEncoding c
1767− toEncoding d >*<
2508+ , toEncoding d
1768− toEncoding e >*<
2509+ , toEncoding e
1769− toEncoding f >*<
2510+ , toEncoding f
1770− toG g >*<
2511+ , toG g
1772 {-# INLINE liftToEncoding2 #-}
2514 {-# INLINE liftToEncoding2 #-}
1774instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
2516instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
@@ -1798,16 +2540,17 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g)
1798 return mv
2540 return mv
1799 {-# INLINE liftToJSON2 #-}
2541 {-# INLINE liftToJSON2 #-}
1801− liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = tuple $
2543+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
1802− toEncoding a >*<
2544+ [ toEncoding a
1803− toEncoding b >*<
2545+ , toEncoding b
1804− toEncoding c >*<
2546+ , toEncoding c
1805− toEncoding d >*<
2547+ , toEncoding d
1806− toEncoding e >*<
2548+ , toEncoding e
1807− toEncoding f >*<
2549+ , toEncoding f
1808− toEncoding g >*<
2550+ , toEncoding g
1809− toH h >*<
2551+ , toH h
1811 {-# INLINE liftToEncoding2 #-}
2554 {-# INLINE liftToEncoding2 #-}
1813instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
2556instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
@@ -1838,17 +2581,18 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
1838 return mv
2581 return mv
1839 {-# INLINE liftToJSON2 #-}
2582 {-# INLINE liftToJSON2 #-}
1841− liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = tuple $
2584+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
1842− toEncoding a >*<
2585+ [ toEncoding a
1843− toEncoding b >*<
2586+ , toEncoding b
1844− toEncoding c >*<
2587+ , toEncoding c
1845− toEncoding d >*<
2588+ , toEncoding d
1846− toEncoding e >*<
2589+ , toEncoding e
1847− toEncoding f >*<
2590+ , toEncoding f
1848− toEncoding g >*<
2591+ , toEncoding g
1849− toEncoding h >*<
2592+ , toEncoding h
1850− toI i >*<
2593+ , toI i
1852 {-# INLINE liftToEncoding2 #-}
2596 {-# INLINE liftToEncoding2 #-}
1854instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
2598instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
@@ -1880,18 +2624,19 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
1880 return mv
2624 return mv
1881 {-# INLINE liftToJSON2 #-}
2625 {-# INLINE liftToJSON2 #-}
1883− liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = tuple $
2627+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
1884− toEncoding a >*<
2628+ [ toEncoding a
1885− toEncoding b >*<
2629+ , toEncoding b
1886− toEncoding c >*<
2630+ , toEncoding c
1887− toEncoding d >*<
2631+ , toEncoding d
1888− toEncoding e >*<
2632+ , toEncoding e
1889− toEncoding f >*<
2633+ , toEncoding f
1890− toEncoding g >*<
2634+ , toEncoding g
1891− toEncoding h >*<
2635+ , toEncoding h
1892− toEncoding i >*<
2636+ , toEncoding i
1893− toJ j >*<
2637+ , toJ j
1895 {-# INLINE liftToEncoding2 #-}
2640 {-# INLINE liftToEncoding2 #-}
1897instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
2642instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
@@ -1924,19 +2669,20 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
1924 return mv
2669 return mv
1925 {-# INLINE liftToJSON2 #-}
2670 {-# INLINE liftToJSON2 #-}
1927− liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = tuple $
2672+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
1928− toEncoding a >*<
2673+ [ toEncoding a
1929− toEncoding b >*<
2674+ , toEncoding b
1930− toEncoding c >*<
2675+ , toEncoding c
1931− toEncoding d >*<
2676+ , toEncoding d
1932− toEncoding e >*<
2677+ , toEncoding e
1933− toEncoding f >*<
2678+ , toEncoding f
1934− toEncoding g >*<
2679+ , toEncoding g
1935− toEncoding h >*<
2680+ , toEncoding h
1936− toEncoding i >*<
2681+ , toEncoding i
1937− toEncoding j >*<
2682+ , toEncoding j
1938− toK k >*<
2683+ , toK k
1940 {-# INLINE liftToEncoding2 #-}
2686 {-# INLINE liftToEncoding2 #-}
1942instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
2688instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
@@ -1970,20 +2716,21 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
1970 return mv
2716 return mv
1971 {-# INLINE liftToJSON2 #-}
2717 {-# INLINE liftToJSON2 #-}
1973− liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = tuple $
2719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
1974− toEncoding a >*<
2720+ [ toEncoding a
1975− toEncoding b >*<
2721+ , toEncoding b
1976− toEncoding c >*<
2722+ , toEncoding c
1977− toEncoding d >*<
2723+ , toEncoding d
1978− toEncoding e >*<
2724+ , toEncoding e
1979− toEncoding f >*<
2725+ , toEncoding f
1980− toEncoding g >*<
2726+ , toEncoding g
1981− toEncoding h >*<
2727+ , toEncoding h
1982− toEncoding i >*<
2728+ , toEncoding i
1983− toEncoding j >*<
2729+ , toEncoding j
1984− toEncoding k >*<
2730+ , toEncoding k
1985− toL l >*<
2731+ , toL l
1987 {-# INLINE liftToEncoding2 #-}
2734 {-# INLINE liftToEncoding2 #-}
1989instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
2736instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
@@ -2018,21 +2765,22 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2018 return mv
2765 return mv
2019 {-# INLINE liftToJSON2 #-}
2766 {-# INLINE liftToJSON2 #-}
2021− liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = tuple $
2768+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2022− toEncoding a >*<
2769+ [ toEncoding a
2023− toEncoding b >*<
2770+ , toEncoding b
2024− toEncoding c >*<
2771+ , toEncoding c
2025− toEncoding d >*<
2772+ , toEncoding d
2026− toEncoding e >*<
2773+ , toEncoding e
2027− toEncoding f >*<
2774+ , toEncoding f
2028− toEncoding g >*<
2775+ , toEncoding g
2029− toEncoding h >*<
2776+ , toEncoding h
2030− toEncoding i >*<
2777+ , toEncoding i
2031− toEncoding j >*<
2778+ , toEncoding j
2032− toEncoding k >*<
2779+ , toEncoding k
2033− toEncoding l >*<
2780+ , toEncoding l
2034− toM m >*<
2781+ , toM m
2036 {-# INLINE liftToEncoding2 #-}
2784 {-# INLINE liftToEncoding2 #-}
2038instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2786instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
@@ -2068,22 +2816,23 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2068 return mv
2816 return mv
2069 {-# INLINE liftToJSON2 #-}
2817 {-# INLINE liftToJSON2 #-}
2071− liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = tuple $
2819+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2072− toEncoding a >*<
2820+ [ toEncoding a
2073− toEncoding b >*<
2821+ , toEncoding b
2074− toEncoding c >*<
2822+ , toEncoding c
2075− toEncoding d >*<
2823+ , toEncoding d
2076− toEncoding e >*<
2824+ , toEncoding e
2077− toEncoding f >*<
2825+ , toEncoding f
2078− toEncoding g >*<
2826+ , toEncoding g
2079− toEncoding h >*<
2827+ , toEncoding h
2080− toEncoding i >*<
2828+ , toEncoding i
2081− toEncoding j >*<
2829+ , toEncoding j
2082− toEncoding k >*<
2830+ , toEncoding k
2083− toEncoding l >*<
2831+ , toEncoding l
2084− toEncoding m >*<
2832+ , toEncoding m
2085− toN n >*<
2833+ , toN n
2087 {-# INLINE liftToEncoding2 #-}
2836 {-# INLINE liftToEncoding2 #-}
2089instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
2838instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
@@ -2097,3 +2846,27 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
2097 {-# INLINE toJSON #-}
2846 {-# INLINE toJSON #-}
2098 toEncoding = toEncoding2
2847 toEncoding = toEncoding2
2099 {-# INLINE toEncoding #-}
2848 {-# INLINE toEncoding #-}
2850+--------------------------------------------------------------------------------
2852+-- | Wrap a list of pairs as an object.
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
2863+-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2864+-- so it can be readily concatenated.
2865+class Monoid kv => KeyValuePair v kv where
2866+ pair :: String -> v -> kv
2868+instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869+ pair k v = DList.singleton (pack k .= v)
2871+instance (e ~ Encoding) => KeyValuePair e Series where