@@ -0,0 +1,2872 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE EmptyDataDecls #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
7+{-# LANGUAGE GADTs #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
12+{-# LANGUAGE RecordWildCards #-}
13+{-# LANGUAGE ScopedTypeVariables #-}
14+{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE UndecidableInstances #-}
16+
17+#include "overlapping-compat.h"
18+#include "incoherent-compat.h"
19+
20+-- TODO: Drop this when we remove support for Data.Attoparsec.Number
21+{-# OPTIONS_GHC -fno-warn-deprecations #-}
22+
23+module Data.Aeson.Types.ToJSON
24+ (
25+ -- * Core JSON classes
26+ ToJSON(..)
27+ -- * Liftings to unary and binary type constructors
28+ , ToJSON1(..)
29+ , toJSON1
30+ , toEncoding1
31+ , ToJSON2(..)
32+ , toJSON2
33+ , toEncoding2
34+ -- * Generic JSON classes
35+ , GToJSON(..)
36+ , ToArgs(..)
37+ , genericToJSON
38+ , genericToEncoding
39+ , genericLiftToJSON
40+ , genericLiftToEncoding
41+ -- * Classes and types for map keys
42+ , ToJSONKey(..)
43+ , ToJSONKeyFunction(..)
44+ , toJSONKeyText
45+ , contramapToJSONKeyFunction
46+
47+ , GToJSONKey()
48+ , genericToJSONKey
49+
50+ -- * Object key-value pairs
51+ , KeyValue(..)
52+ , KeyValuePair(..)
53+ , FromPairs(..)
54+ -- * Functions needed for documentation
55+ -- * Encoding functions
56+ , listEncoding
57+ , listValue
58+ ) where
59+
60+import Prelude.Compat
61+
62+import Control.Applicative (Const(..))
63+import Control.Monad.ST (ST)
64+import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
65+import Data.Aeson.Encoding.Internal ((>*<))
66+import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
67+import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
68+import Data.Aeson.Types.Internal
69+import Data.Attoparsec.Number (Number(..))
70+import Data.Bits (unsafeShiftR)
71+import Data.DList (DList)
72+import Data.Fixed (Fixed, HasResolution, Nano)
73+import Data.Foldable (toList)
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(..))
79+import Data.Int (Int16, Int32, Int64, Int8)
80+import Data.List (intersperse)
81+import Data.List.NonEmpty (NonEmpty(..))
82+import Data.Semigroup ((<>))
83+import Data.Proxy (Proxy(..))
84+import Data.Ratio (Ratio, denominator, numerator)
85+import Data.Scientific (Scientific)
86+import Data.Tagged (Tagged(..))
87+import Data.Text (Text, pack)
88+import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
89+import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
90+import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
91+import Data.Time.Clock.System.Compat (SystemTime (..))
92+import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
93+import Data.Vector (Vector)
94+import Data.Version (Version, showVersion)
95+import Data.Void (Void, absurd)
96+import Data.Word (Word16, Word32, Word64, Word8)
97+import Foreign.Storable (Storable)
98+import Foreign.C.Types (CTime (..))
99+import GHC.Generics
100+import Numeric.Natural (Natural)
101+import qualified Data.Aeson.Encoding as E
102+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
103+import qualified Data.ByteString.Lazy as L
104+import qualified Data.DList as DList
105+import qualified Data.HashMap.Strict as H
106+import qualified Data.HashSet as HashSet
107+import qualified Data.IntMap as IntMap
108+import qualified Data.IntSet as IntSet
109+import qualified Data.List.NonEmpty as NE
110+import qualified Data.Map as M
111+import qualified Data.Monoid as Monoid
112+import qualified Data.Scientific as Scientific
113+import qualified Data.Semigroup as Semigroup
114+import qualified Data.Sequence as Seq
115+import qualified Data.Set as Set
116+import qualified Data.Text as T
117+import qualified Data.Text.Encoding as T
118+import qualified Data.Text.Lazy as LT
119+import qualified Data.Tree as Tree
120+import qualified Data.UUID.Types as UUID
121+import qualified Data.Vector as V
122+import qualified Data.Vector.Generic as VG
123+import qualified Data.Vector.Mutable as VM
124+import qualified Data.Vector.Primitive as VP
125+import qualified Data.Vector.Storable as VS
126+import qualified Data.Vector.Unboxed as VU
127+
128+import qualified Data.Aeson.Encoding.Builder as EB
129+import qualified Data.ByteString.Builder as B
130+
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
135+
136+#if MIN_VERSION_primitive(0,6,4)
137+#if !MIN_VERSION_primitive(0,7,0)
138+import qualified Data.Primitive.UnliftedArray as PM
139+#endif
140+import qualified Data.Primitive.PrimArray as PM
141+#endif
142+
143+toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
144+toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
145+{-# INLINE toJSONPair #-}
146+
147+realFloatToJSON :: RealFloat a => a -> Value
148+realFloatToJSON d
149+ | isNaN d || isInfinite d = Null
150+ | otherwise = Number $ Scientific.fromFloatDigits d
151+{-# INLINE realFloatToJSON #-}
152+
153+-------------------------------------------------------------------------------
154+-- Generics
155+-------------------------------------------------------------------------------
156+
157+-- | Class of generic representation types that can be converted to
158+-- JSON.
159+class GToJSON enc arity f where
160+ -- | This method (applied to 'defaultOptions') is used as the
161+ -- default generic implementation of 'toJSON'
162+ -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
163+ -- and 'liftToJSON' (if the @arity@ is 'One').
164+ --
165+ -- It also provides a generic implementation of 'toEncoding'
166+ -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
167+ -- and 'liftToEncoding' (if the @arity@ is 'One').
168+ gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
169+
170+-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the two
171+-- function arguments that encode occurrences of the type parameter (for
172+-- 'ToJSON1').
173+data ToArgs res arity a where
174+ NoToArgs :: ToArgs res Zero a
175+ To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
176+
177+-- | A configurable generic JSON creator. This function applied to
178+-- 'defaultOptions' is used as the default for 'toJSON' when the type
179+-- is an instance of 'Generic'.
180+genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
181+ => Options -> a -> Value
182+genericToJSON opts = gToJSON opts NoToArgs . from
183+
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)
189+ -> f a -> Value
190+genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
191+
192+-- | A configurable generic JSON encoder. This function applied to
193+-- 'defaultOptions' is used as the default for 'toEncoding' when the type
194+-- is an instance of 'Generic'.
195+genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
196+ => Options -> a -> Encoding
197+genericToEncoding opts = gToJSON opts NoToArgs . from
198+
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)
204+ -> f a -> Encoding
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
206+
207+-------------------------------------------------------------------------------
208+-- Class
209+-------------------------------------------------------------------------------
210+
211+-- | A type that can be converted to JSON.
212+--
213+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214+-- to) specify 'toEncoding'.
215+--
216+-- An example type and instance:
217+--
218+-- @
219+-- \-- Allow ourselves to write 'Text' literals.
220+-- {-\# LANGUAGE OverloadedStrings #-}
221+--
222+-- data Coord = Coord { x :: Double, y :: Double }
223+--
224+-- instance 'ToJSON' Coord where
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
226+--
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
228+-- @
229+--
230+-- Instead of manually writing your 'ToJSON' instance, there are two options
231+-- to do it automatically:
232+--
233+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
234+-- instance at compile time. The generated instance is optimized for your type
235+-- so it will probably be more efficient than the following option.
236+--
237+-- * The compiler can provide a default generic implementation for
238+-- 'toJSON'.
239+--
240+-- To use the second, simply add a @deriving 'Generic'@ clause to your
241+-- datatype and declare a 'ToJSON' instance. If you require nothing other than
242+-- 'defaultOptions', it is sufficient to write (and this is the only
243+-- alternative where the default 'toJSON' implementation is sufficient):
244+--
245+-- @
246+-- {-\# LANGUAGE DeriveGeneric \#-}
247+--
248+-- import "GHC.Generics"
249+--
250+-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
251+--
252+-- instance 'ToJSON' Coord where
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
254+-- @
255+--
256+-- If on the other hand you wish to customize the generic decoding, you have
257+-- to implement both methods:
258+--
259+-- @
260+-- customOptions = 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
262+-- }
263+--
264+-- instance 'ToJSON' Coord where
265+-- 'toJSON' = 'genericToJSON' customOptions
266+-- 'toEncoding' = 'genericToEncoding' customOptions
267+-- @
268+--
269+-- Previous versions of this library only had the 'toJSON' method. Adding
270+-- 'toEncoding' had two reasons:
271+--
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
275+-- non-optimal.
276+--
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.)
287+class ToJSON a where
288+ -- | Convert a Haskell value to a JSON-friendly intermediate type.
289+ toJSON :: a -> Value
290+
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
292+ toJSON = genericToJSON defaultOptions
293+
294+ -- | Encode a Haskell value as JSON.
295+ --
296+ -- The default implementation of this method creates an
297+ -- intermediate 'Value' using 'toJSON'. This provides
298+ -- source-level compatibility for people upgrading from older
299+ -- versions of this library, but obviously offers no performance
300+ -- advantage.
301+ --
302+ -- To benefit from direct encoding, you /must/ provide an
303+ -- implementation for this method. The easiest way to do so is by
304+ -- having your types implement 'Generic' using the @DeriveGeneric@
305+ -- extension, and then have GHC generate a method body as follows.
306+ --
307+ -- @
308+ -- instance 'ToJSON' Coord where
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
310+ -- @
311+
312+ toEncoding :: a -> Encoding
313+ toEncoding = E.value . toJSON
314+ {-# INLINE toEncoding #-}
315+
316+ toJSONList :: [a] -> Value
317+ toJSONList = listValue toJSON
318+ {-# INLINE toJSONList #-}
319+
320+ toEncodingList :: [a] -> Encoding
321+ toEncodingList = listEncoding toEncoding
322+ {-# INLINE toEncodingList #-}
323+
324+-------------------------------------------------------------------------------
325+-- Object key-value pairs
326+-------------------------------------------------------------------------------
327+
328+-- | A key-value pair for encoding a JSON object.
329+class KeyValue kv where
330+ (.=) :: ToJSON v => Text -> v -> kv
331+ infixr 8 .=
332+
333+instance KeyValue Series where
334+ name .= value = E.pair name (toEncoding value)
335+ {-# INLINE (.=) #-}
336+
337+instance KeyValue Pair where
338+ name .= value = (name, toJSON value)
339+ {-# INLINE (.=) #-}
340+
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)
346+ {-# INLINE (.=) #-}
347+
348+-------------------------------------------------------------------------------
349+-- Classes and types for map keys
350+-------------------------------------------------------------------------------
351+
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':
356+--
357+-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
358+-- {"foo":"a"}
359+--
360+-- Since 'Int' also has a 'ToJSONKey' instance, we can similarly write:
361+--
362+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(5 :: Int, 'a')]
363+-- {"5":"a"}
364+--
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.
368+--
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.
373+--
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:
376+--
377+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(["foo","bar","baz" :: Text], 'a')]
378+-- [[["foo","bar","baz"],"a"]]
379+--
380+-- The default implementation of 'ToJSONKey' chooses this method of
381+-- encoding a key, using the 'ToJSON' instance of the type.
382+--
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:
389+--
390+-- > data Foo = Foo { fooAge :: Int, fooName :: Text }
391+-- > deriving (Eq,Ord,Generic)
392+-- > instance ToJSON Foo
393+-- > instance ToJSONKey Foo
394+--
395+-- That's it. We can now write:
396+--
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"]]
400+--
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:
404+--
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
406+-- > deriving (Eq,Ord,ToJSONKey)
407+--
408+-- Then we may write:
409+--
410+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
411+-- {"abc":"a"}
412+--
413+-- Simple sum types are a final case worth considering. Suppose we have:
414+--
415+-- > data Color = Red | Green | Blue
416+-- > deriving (Show,Read,Eq,Ord)
417+--
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:
424+--
425+-- @
426+-- instance 'ToJSONKey' Color where
427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
428+-- @
429+--
430+-- === __Low-level implementations__
431+--
432+-- The 'Show' instance can be used to help write 'ToJSONKey':
433+--
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
439+--
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:
443+--
444+-- > instance ToJSONKey Color where
445+-- > toJSONKey = toJSONKeyText (Text.pack . show)
446+--
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:
455+--
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
462+--
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.
467+
468+class ToJSONKey a where
469+ -- | Strategy for rendering the key for a map-like container.
470+ toJSONKey :: ToJSONKeyFunction a
471+ default toJSONKey :: ToJSON a => ToJSONKeyFunction a
472+ toJSONKey = ToJSONKeyValue toJSON toEncoding
473+
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.
478+ toJSONKeyList :: ToJSONKeyFunction [a]
479+ default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
480+ toJSONKeyList = ToJSONKeyValue toJSON toEncoding
481+
482+data ToJSONKeyFunction a
483+ = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
484+ -- ^ key is encoded to string, produces object
485+ | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
486+ -- ^ key is encoded to value, produces array
487+
488+-- | Helper for creating textual keys.
489+--
490+-- @
491+-- instance 'ToJSONKey' MyKey where
492+-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
493+-- where
494+-- myKeyToText = Text.pack . show -- or showt from text-show
495+-- @
496+toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
497+toJSONKeyText f = ToJSONKeyText f (E.text . f)
498+
499+-- | TODO: should this be exported?
500+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
501+toJSONKeyTextEnc e = ToJSONKeyText tot e
502+ where
503+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504+ tot = T.dropAround (== '"')
505+ . T.decodeLatin1
506+ . L.toStrict
507+ . E.encodingToLazyByteString
508+ . e
509+
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
512+
513+-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
514+contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
515+contramapToJSONKeyFunction h x = case x of
516+ ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
517+ ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
518+
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
522+-- objects.
523+--
524+-- See also 'genericFromJSONKey'.
525+--
526+-- === __Example__
527+--
528+-- @
529+-- data Color = Red | Green | Blue
530+-- deriving 'Generic'
531+--
532+-- instance 'ToJSONKey' Color where
533+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
534+-- @
535+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
536+ => JSONKeyOptions -> ToJSONKeyFunction a
537+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)
538+
539+class GetConName f => GToJSONKey f
540+instance GetConName f => GToJSONKey f
541+
542+-------------------------------------------------------------------------------
543+-- Lifings of FromJSON and ToJSON to unary and binary type constructors
544+-------------------------------------------------------------------------------
545+
546+
547+-- | Lifting of the 'ToJSON' class to unary type constructors.
548+--
549+-- Instead of manually writing your 'ToJSON1' instance, there are two options
550+-- to do it automatically:
551+--
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.
555+--
556+-- * The compiler can provide a default generic implementation for
557+-- 'toJSON1'.
558+--
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'.
562+--
563+-- For example:
564+--
565+-- @
566+-- {-\# LANGUAGE DeriveGeneric \#-}
567+--
568+-- import "GHC.Generics"
569+--
570+-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
571+--
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
573+-- @
574+--
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':
579+--
580+-- @
581+-- customOptions = 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
583+-- }
584+--
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
588+-- @
589+--
590+-- See also 'ToJSON'.
591+class ToJSON1 f where
592+ liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
593+
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
595+ => (a -> Value) -> ([a] -> Value) -> f a -> Value
596+ liftToJSON = genericLiftToJSON defaultOptions
597+
598+ liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
599+ liftToJSONList f g = listValue (liftToJSON f g)
600+
601+ liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
602+
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
604+ => (a -> Encoding) -> ([a] -> Encoding)
605+ -> f a -> Encoding
606+ liftToEncoding = genericLiftToEncoding defaultOptions
607+
608+ liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
609+ liftToEncodingList f g = listEncoding (liftToEncoding f g)
610+
611+-- | Lift the standard 'toJSON' function through the type constructor.
612+toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value
613+toJSON1 = liftToJSON toJSON toJSONList
614+{-# INLINE toJSON1 #-}
615+
616+-- | Lift the standard 'toEncoding' function through the type constructor.
617+toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
618+toEncoding1 = liftToEncoding toEncoding toEncodingList
619+{-# INLINE toEncoding1 #-}
620+
621+-- | Lifting of the 'ToJSON' class to binary type constructors.
622+--
623+-- Instead of manually writing your 'ToJSON2' instance, "Data.Aeson.TH"
624+-- provides Template Haskell functions which will derive an instance at compile time.
625+--
626+-- The compiler cannot provide a default generic implementation for 'liftToJSON2',
627+-- unlike 'toJSON' and 'liftToJSON'.
628+class ToJSON2 f where
629+ liftToJSON2 :: (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
631+ liftToJSONList2 fa ga fb gb = listValue (liftToJSON2 fa ga fb gb)
632+
633+ liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding
634+ liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding
635+ liftToEncodingList2 fa ga fb gb = listEncoding (liftToEncoding2 fa ga fb gb)
636+
637+-- | Lift the standard 'toJSON' function through the type constructor.
638+toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value
639+toJSON2 = liftToJSON2 toJSON toJSONList toJSON toJSONList
640+{-# INLINE toJSON2 #-}
641+
642+-- | Lift the standard 'toEncoding' function through the type constructor.
643+toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding
644+toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingList
645+{-# INLINE toEncoding2 #-}
646+
647+-------------------------------------------------------------------------------
648+-- Encoding functions
649+-------------------------------------------------------------------------------
650+
651+-- | Helper function to use with 'liftToEncoding'.
652+-- Useful when writing own 'ToJSON1' instances.
653+--
654+-- @
655+-- newtype F a = F [a]
656+--
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
661+--
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
664+-- @
665+listEncoding :: (a -> Encoding) -> [a] -> Encoding
666+listEncoding = E.list
667+{-# INLINE listEncoding #-}
668+
669+-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
670+listValue :: (a -> Value) -> [a] -> Value
671+listValue f = Array . V.fromList . map f
672+{-# INLINE listValue #-}
673+
674+-------------------------------------------------------------------------------
675+-- [] instances
676+-------------------------------------------------------------------------------
677+
678+-- These are needed for key-class default definitions
679+
680+instance ToJSON1 [] where
681+ liftToJSON _ to' = to'
682+ {-# INLINE liftToJSON #-}
683+
684+ liftToEncoding _ to' = to'
685+ {-# INLINE liftToEncoding #-}
686+
687+instance (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] #-}
692+
693+ toJSON = toJSON1
694+ {-# INLINE toJSON #-}
695+
696+ toEncoding = toEncoding1
697+ {-# INLINE toEncoding #-}
698+
699+-------------------------------------------------------------------------------
700+-- Generic toJSON / toEncoding
701+-------------------------------------------------------------------------------
702+
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 #-}
707+
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 #-}
713+
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.
720+ gToJSON opts targs
721+ | tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
722+ . sumToJSON opts targs
723+ . unM1
724+ | otherwise = consToJSON opts targs . unM1 . unM1
725+ {-# INLINE gToJSON #-}
726+
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 #-}
732+
733+instance ( AllNullary (a :+: b) allNullary
734+ , SumToJSON enc arity (a :+: b) allNullary
735+ ) => GToJSON enc arity (a :+: b)
736+ where
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 #-}
743+
744+--------------------------------------------------------------------------------
745+-- Generic toJSON
746+
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
749+-- instances.
750+
751+instance GToJSON Value arity V1 where
752+ -- Empty values do not exist, which makes the job of formatting them
753+ -- rather easy:
754+ gToJSON _ _ x = x `seq` error "case: V1"
755+ {-# INLINE gToJSON #-}
756+
757+instance ToJSON a => GToJSON Value arity (K1 i a) where
758+ -- Constant values are encoded using their ToJSON instance:
759+ gToJSON _opts _ = toJSON . unK1
760+ {-# INLINE gToJSON #-}
761+
762+instance ToJSON1 f => GToJSON Value One (Rec1 f) where
763+ -- Recursive occurrences of the last type parameter are encoded using their
764+ -- ToJSON1 instance:
765+ gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
766+ {-# INLINE gToJSON #-}
767+
768+instance GToJSON Value arity U1 where
769+ -- Empty constructors are encoded to an empty array:
770+ gToJSON _opts _ _ = emptyArray
771+ {-# INLINE gToJSON #-}
772+
773+instance ( WriteProduct arity a, WriteProduct arity b
774+ , ProductSize a, ProductSize b
775+ ) => GToJSON Value arity (a :*: b)
776+ where
777+ -- Products are encoded to an array. Here we allocate a mutable vector of
778+ -- the same size as the product and write the product's elements to it using
779+ -- 'writeProduct':
780+ gToJSON opts targs p =
781+ Array $ V.create $ do
782+ mv <- VM.unsafeNew lenProduct
783+ writeProduct opts targs mv 0 lenProduct p
784+ return mv
785+ where
786+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
787+ productSize
788+ {-# INLINE gToJSON #-}
789+
790+instance ( ToJSON1 f
791+ , GToJSON Value One g
792+ ) => GToJSON Value One (f :.: g)
793+ where
794+ -- If an occurrence of the last type parameter is nested inside two
795+ -- composed types, it is encoded by using the outermost type's ToJSON1
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 #-}
801+
802+--------------------------------------------------------------------------------
803+-- Generic toEncoding
804+
805+instance ToJSON a => GToJSON Encoding arity (K1 i a) where
806+ -- Constant values are encoded using their ToJSON instance:
807+ gToJSON _opts _ = toEncoding . unK1
808+ {-# INLINE gToJSON #-}
809+
810+instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
811+ -- Recursive occurrences of the last type parameter are encoded using their
812+ -- ToEncoding1 instance:
813+ gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
814+ {-# INLINE gToJSON #-}
815+
816+instance GToJSON Encoding arity U1 where
817+ -- Empty constructors are encoded to an empty array:
818+ gToJSON _opts _ _ = E.emptyArray_
819+ {-# INLINE gToJSON #-}
820+
821+instance ( EncodeProduct arity a
822+ , EncodeProduct arity b
823+ ) => GToJSON Encoding arity (a :*: b)
824+ where
825+ -- Products are encoded to an array. Here we allocate a mutable vector of
826+ -- the same size as the product and write the product's elements to it using
827+ -- 'encodeProduct':
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829+ {-# INLINE gToJSON #-}
830+
831+instance ( ToJSON1 f
832+ , GToJSON Encoding One g
833+ ) => GToJSON Encoding One (f :.: g)
834+ where
835+ -- If an occurrence of the last type parameter is nested inside two
836+ -- composed types, it is encoded by using the outermost type's ToJSON1
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 #-}
842+
843+--------------------------------------------------------------------------------
844+
845+class SumToJSON enc arity f allNullary where
846+ sumToJSON :: Options -> ToArgs enc arity a
847+ -> f a -> Tagged allNullary enc
848+
849+instance ( GetConName f
850+ , FromString enc
851+ , TaggedObject enc arity f
852+ , SumToJSON' ObjectWithSingleField enc arity f
853+ , SumToJSON' TwoElemArray enc arity f
854+ , SumToJSON' UntaggedValue enc arity f
855+ ) => SumToJSON enc arity f True
856+ where
857+ sumToJSON opts targs
858+ | allNullaryToStringTag opts = Tagged . fromString
859+ . constructorTagModifier opts . getConName
860+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs
861+
862+instance ( TaggedObject enc arity f
863+ , SumToJSON' ObjectWithSingleField enc arity f
864+ , SumToJSON' TwoElemArray enc arity f
865+ , SumToJSON' UntaggedValue enc arity f
866+ ) => SumToJSON enc arity f False
867+ where
868+ sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
869+
870+nonAllNullarySumToJSON :: ( TaggedObject enc arity f
871+ , SumToJSON' ObjectWithSingleField enc arity f
872+ , SumToJSON' TwoElemArray enc arity f
873+ , SumToJSON' UntaggedValue enc arity f
874+ ) => Options -> ToArgs enc arity a
875+ -> f a -> enc
876+nonAllNullarySumToJSON opts targs =
877+ case sumEncoding opts of
878+
879+ TaggedObject{..} ->
880+ taggedObject opts targs tagFieldName contentsFieldName
881+
882+ ObjectWithSingleField ->
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
885+
886+ TwoElemArray ->
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
888+ . sumToJSON' opts targs
889+
890+ UntaggedValue ->
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
892+ . sumToJSON' opts targs
893+
894+--------------------------------------------------------------------------------
895+
896+class FromString enc where
897+ fromString :: String -> enc
898+
899+instance FromString Encoding where
900+ fromString = toEncoding
901+
902+instance FromString Value where
903+ fromString = String . pack
904+
905+--------------------------------------------------------------------------------
906+
907+class TaggedObject enc arity f where
908+ taggedObject :: Options -> ToArgs enc arity a
909+ -> String -> String
910+ -> f a -> enc
911+
912+instance ( TaggedObject enc arity a
913+ , TaggedObject enc arity b
914+ ) => TaggedObject enc arity (a :+: b)
915+ where
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
917+ taggedObject opts targs tagFieldName contentsFieldName x
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
919+ taggedObject opts targs tagFieldName contentsFieldName x
920+
921+instance ( IsRecord a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
924+ , FromString enc
925+ , KeyValuePair enc pairs
926+ , Constructor c
927+ ) => TaggedObject enc arity (C1 c a)
928+ where
929+ taggedObject opts targs tagFieldName contentsFieldName =
930+ fromPairs . mappend tag . contents
931+ where
932+ tag = tagFieldName `pair`
933+ (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
934+ :: enc)
935+ contents =
936+ (unTagged :: Tagged isRecord pairs -> pairs) .
937+ taggedObject' opts targs contentsFieldName . unM1
938+
939+class TaggedObject' enc pairs arity f isRecord where
940+ taggedObject' :: Options -> ToArgs enc arity a
941+ -> String -> f a -> Tagged isRecord pairs
942+
943+instance ( GToJSON enc arity f
944+ , KeyValuePair enc pairs
945+ ) => TaggedObject' enc pairs arity f False
946+ where
947+ taggedObject' opts targs contentsFieldName =
948+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs
949+
950+instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
951+ taggedObject' _ _ _ _ = Tagged mempty
952+
953+instance ( RecordToPairs enc pairs arity f
954+ ) => TaggedObject' enc pairs arity f True
955+ where
956+ taggedObject' opts targs _ = Tagged . recordToPairs opts targs
957+
958+--------------------------------------------------------------------------------
959+
960+-- | Get the name of the constructor of a sum datatype.
961+class GetConName f where
962+ getConName :: f a -> String
963+
964+instance (GetConName a, GetConName b) => GetConName (a :+: b) where
965+ getConName (L1 x) = getConName x
966+ getConName (R1 x) = getConName x
967+
968+instance (Constructor c) => GetConName (C1 c a) where
969+ getConName = conName
970+
971+-- For genericToJSONKey
972+instance GetConName a => GetConName (D1 d a) where
973+ getConName (M1 x) = getConName x
974+
975+--------------------------------------------------------------------------------
976+
977+-- Reflection of SumEncoding variants
978+
979+data ObjectWithSingleField
980+data TwoElemArray
981+data UntaggedValue
982+
983+--------------------------------------------------------------------------------
984+
985+class SumToJSON' s enc arity f where
986+ sumToJSON' :: Options -> ToArgs enc arity a
987+ -> f a -> Tagged s enc
988+
989+instance ( SumToJSON' s enc arity a
990+ , SumToJSON' s enc arity b
991+ ) => SumToJSON' s enc arity (a :+: b)
992+ where
993+ sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994+ sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
995+
996+--------------------------------------------------------------------------------
997+
998+instance ( GToJSON Value arity a
999+ , ConsToJSON Value arity a
1000+ , Constructor c
1001+ ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
1002+ sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
1003+ mv <- VM.unsafeNew 2
1004+ VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
1005+ $ conName (undefined :: t c a p)
1006+ VM.unsafeWrite mv 1 $ gToJSON opts targs x
1007+ return mv
1008+
1009+--------------------------------------------------------------------------------
1010+
1011+instance ( GToJSON Encoding arity a
1012+ , ConsToJSON Encoding arity a
1013+ , Constructor c
1014+ ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
1015+ where
1016+ sumToJSON' opts targs x = Tagged $ E.list id
1017+ [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
1018+ , gToJSON opts targs x
1019+ ]
1020+
1021+--------------------------------------------------------------------------------
1022+
1023+class ConsToJSON enc arity f where
1024+ consToJSON :: Options -> ToArgs enc arity a
1025+ -> f a -> enc
1026+
1027+class ConsToJSON' enc arity f isRecord where
1028+ consToJSON' :: Options -> ToArgs enc arity a
1029+ -> f a -> Tagged isRecord enc
1030+
1031+instance ( IsRecord f isRecord
1032+ , ConsToJSON' enc arity f isRecord
1033+ ) => ConsToJSON enc arity f
1034+ where
1035+ consToJSON opts targs =
1036+ (unTagged :: Tagged isRecord enc -> enc)
1037+ . consToJSON' opts targs
1038+ {-# INLINE consToJSON #-}
1039+
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
1045+ where
1046+ consToJSON' opts targs
1047+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049+ {-# INLINE consToJSON' #-}
1050+
1051+instance ( RecordToPairs enc pairs arity f
1052+ , FromPairs enc pairs
1053+ ) => ConsToJSON' enc arity f True
1054+ where
1055+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056+ {-# INLINE consToJSON' #-}
1057+
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1060+ {-# INLINE consToJSON' #-}
1061+
1062+--------------------------------------------------------------------------------
1063+
1064+class RecordToPairs enc pairs arity f where
1065+ -- 1st element: whole thing
1066+ -- 2nd element: in case the record has only 1 field, just the value
1067+ -- of the field (without the key); 'Nothing' otherwise
1068+ recordToPairs :: Options -> ToArgs enc arity a
1069+ -> f a -> pairs
1070+
1071+instance ( Monoid pairs
1072+ , RecordToPairs enc pairs arity a
1073+ , RecordToPairs enc pairs arity b
1074+ ) => RecordToPairs enc pairs arity (a :*: b)
1075+ where
1076+ recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1077+ pairsOf a `mappend` pairsOf b
1078+ where
1079+ pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1080+ pairsOf = recordToPairs opts targs
1081+ {-# INLINE recordToPairs #-}
1082+
1083+instance ( Selector s
1084+ , GToJSON enc arity a
1085+ , KeyValuePair enc pairs
1086+ ) => RecordToPairs enc pairs arity (S1 s a)
1087+ where
1088+ recordToPairs = fieldToPair
1089+ {-# INLINE recordToPairs #-}
1090+
1091+instance INCOHERENT_
1092+ ( Selector s
1093+ , GToJSON enc arity (K1 i (Maybe a))
1094+ , KeyValuePair enc pairs
1095+ , Monoid pairs
1096+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1097+ where
1098+ recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099+ , K1 Nothing <- k1 = mempty
1100+ recordToPairs opts targs m1 = fieldToPair opts targs m1
1101+ {-# INLINE recordToPairs #-}
1102+
1103+instance INCOHERENT_
1104+ ( Selector s
1105+ , GToJSON enc arity (K1 i (Maybe a))
1106+ , KeyValuePair enc pairs
1107+ , Monoid pairs
1108+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1109+ where
1110+ recordToPairs opts targs = recordToPairs opts targs . unwrap
1111+ where
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 #-}
1115+
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 =
1122+ let key = fieldLabelModifier opts (selName m1)
1123+ value = gToJSON opts targs (unM1 m1)
1124+ in key `pair` value
1125+{-# INLINE fieldToPair #-}
1126+
1127+--------------------------------------------------------------------------------
1128+
1129+class WriteProduct arity f where
1130+ writeProduct :: Options
1131+ -> ToArgs Value arity a
1132+ -> VM.MVector s Value
1133+ -> Int -- ^ index
1134+ -> Int -- ^ length
1135+ -> f a
1136+ -> ST s ()
1137+
1138+instance ( WriteProduct arity a
1139+ , WriteProduct arity b
1140+ ) => WriteProduct arity (a :*: b) where
1141+ writeProduct opts targs mv ix len (a :*: b) = do
1142+ writeProduct opts targs mv ix lenL a
1143+ writeProduct opts targs mv ixR lenR b
1144+ where
1145+ lenL = len `unsafeShiftR` 1
1146+ lenR = len - lenL
1147+ ixR = ix + lenL
1148+ {-# INLINE writeProduct #-}
1149+
1150+instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
1151+ writeProduct opts targs mv ix _ =
1152+ VM.unsafeWrite mv ix . gToJSON opts targs
1153+ {-# INLINE writeProduct #-}
1154+
1155+--------------------------------------------------------------------------------
1156+
1157+class EncodeProduct arity f where
1158+ encodeProduct :: Options -> ToArgs Encoding arity a
1159+ -> f a -> Encoding' E.InArray
1160+
1161+instance ( EncodeProduct arity a
1162+ , EncodeProduct arity b
1163+ ) => EncodeProduct arity (a :*: b) where
1164+ encodeProduct opts targs (a :*: b) | omitNothingFields opts =
1165+ E.econcat $ intersperse E.comma $
1166+ filter (not . E.nullEncoding)
1167+ [encodeProduct opts targs a, encodeProduct opts targs b]
1168+ encodeProduct opts targs (a :*: b) =
1169+ encodeProduct opts targs a >*<
1170+ encodeProduct opts targs b
1171+ {-# INLINE encodeProduct #-}
1172+
1173+instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
1174+ encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
1175+ {-# INLINE encodeProduct #-}
1176+
1177+--------------------------------------------------------------------------------
1178+
1179+instance ( GToJSON enc arity a
1180+ , ConsToJSON enc arity a
1181+ , FromPairs enc pairs
1182+ , KeyValuePair enc pairs
1183+ , Constructor c
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1185+ where
1186+ sumToJSON' opts targs =
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1188+ where
1189+ typ = constructorTagModifier opts $
1190+ conName (undefined :: t c a p)
1191+
1192+--------------------------------------------------------------------------------
1193+
1194+instance OVERLAPPABLE_
1195+ ( ConsToJSON enc arity a
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1197+ where
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
1199+
1200+instance OVERLAPPING_
1201+ ( Constructor c
1202+ , FromString enc
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1204+ where
1205+ sumToJSON' opts _ _ = Tagged . fromString $
1206+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
1207+
1208+-------------------------------------------------------------------------------
1209+-- Instances
1210+-------------------------------------------------------------------------------
1211+
1212+-------------------------------------------------------------------------------
1213+-- base
1214+-------------------------------------------------------------------------------
1215+
1216+instance ToJSON2 Const where
1217+ liftToJSON2 t _ _ _ (Const x) = t x
1218+ {-# INLINE liftToJSON2 #-}
1219+
1220+ liftToEncoding2 t _ _ _ (Const x) = t x
1221+ {-# INLINE liftToEncoding2 #-}
1222+
1223+instance ToJSON a => ToJSON1 (Const a) where
1224+ liftToJSON _ _ (Const x) = toJSON x
1225+ {-# INLINE liftToJSON #-}
1226+
1227+ liftToEncoding _ _ (Const x) = toEncoding x
1228+ {-# INLINE liftToEncoding #-}
1229+
1230+instance ToJSON a => ToJSON (Const a b) where
1231+ toJSON (Const x) = toJSON x
1232+ {-# INLINE toJSON #-}
1233+
1234+ toEncoding (Const x) = toEncoding x
1235+ {-# INLINE toEncoding #-}
1236+
1237+
1238+instance ToJSON1 Maybe where
1239+ liftToJSON t _ (Just a) = t a
1240+ liftToJSON _ _ Nothing = Null
1241+ {-# INLINE liftToJSON #-}
1242+
1243+ liftToEncoding t _ (Just a) = t a
1244+ liftToEncoding _ _ Nothing = E.null_
1245+ {-# INLINE liftToEncoding #-}
1246+
1247+instance (ToJSON a) => ToJSON (Maybe a) where
1248+ toJSON = toJSON1
1249+ {-# INLINE toJSON #-}
1250+
1251+ toEncoding = toEncoding1
1252+ {-# INLINE toEncoding #-}
1253+
1254+
1255+instance ToJSON2 Either where
1256+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
1257+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
1258+ {-# INLINE liftToJSON2 #-}
1259+
1260+ liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
1261+
1262+ liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b
1263+ {-# INLINE liftToEncoding2 #-}
1264+
1265+instance (ToJSON a) => ToJSON1 (Either a) where
1266+ liftToJSON = liftToJSON2 toJSON toJSONList
1267+ {-# INLINE liftToJSON #-}
1268+
1269+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
1270+ {-# INLINE liftToEncoding #-}
1271+
1272+instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1273+ toJSON = toJSON2
1274+ {-# INLINE toJSON #-}
1275+
1276+ toEncoding = toEncoding2
1277+ {-# INLINE toEncoding #-}
1278+
1279+instance ToJSON Void where
1280+ toJSON = absurd
1281+ {-# INLINE toJSON #-}
1282+
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
1285+
1286+
1287+instance ToJSON Bool where
1288+ toJSON = Bool
1289+ {-# INLINE toJSON #-}
1290+
1291+ toEncoding = E.bool
1292+ {-# INLINE toEncoding #-}
1293+
1294+instance ToJSONKey Bool where
1295+ toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
1296+
1297+
1298+instance ToJSON Ordering where
1299+ toJSON = toJSON . orderingToText
1300+ toEncoding = toEncoding . orderingToText
1301+
1302+orderingToText :: Ordering -> T.Text
1303+orderingToText o = case o of
1304+ LT -> "LT"
1305+ EQ -> "EQ"
1306+ GT -> "GT"
1307+
1308+instance ToJSON () where
1309+ toJSON _ = emptyArray
1310+ {-# INLINE toJSON #-}
1311+
1312+ toEncoding _ = emptyArray_
1313+ {-# INLINE toEncoding #-}
1314+
1315+
1316+instance ToJSON Char where
1317+ toJSON = String . T.singleton
1318+ {-# INLINE toJSON #-}
1319+
1320+ toJSONList = String . T.pack
1321+ {-# INLINE toJSONList #-}
1322+
1323+ toEncoding = E.string . (:[])
1324+ {-# INLINE toEncoding #-}
1325+
1326+ toEncodingList = E.string
1327+ {-# INLINE toEncodingList #-}
1328+
1329+
1330+instance ToJSON Double where
1331+ toJSON = realFloatToJSON
1332+ {-# INLINE toJSON #-}
1333+
1334+ toEncoding = E.double
1335+ {-# INLINE toEncoding #-}
1336+
1337+instance ToJSONKey Double where
1338+ toJSONKey = toJSONKeyTextEnc E.doubleText
1339+ {-# INLINE toJSONKey #-}
1340+
1341+
1342+instance ToJSON Number where
1343+ toJSON (D d) = toJSON d
1344+ toJSON (I i) = toJSON i
1345+ {-# INLINE toJSON #-}
1346+
1347+ toEncoding (D d) = toEncoding d
1348+ toEncoding (I i) = toEncoding i
1349+ {-# INLINE toEncoding #-}
1350+
1351+
1352+instance ToJSON Float where
1353+ toJSON = realFloatToJSON
1354+ {-# INLINE toJSON #-}
1355+
1356+ toEncoding = E.float
1357+ {-# INLINE toEncoding #-}
1358+
1359+instance ToJSONKey Float where
1360+ toJSONKey = toJSONKeyTextEnc E.floatText
1361+ {-# INLINE toJSONKey #-}
1362+
1363+
1364+instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
1365+ toJSON r = object [ "numerator" .= numerator r
1366+ , "denominator" .= denominator r
1367+ ]
1368+ {-# INLINE toJSON #-}
1369+
1370+ toEncoding r = E.pairs $
1371+ "numerator" .= numerator r <>
1372+ "denominator" .= denominator r
1373+ {-# INLINE toEncoding #-}
1374+
1375+
1376+instance HasResolution a => ToJSON (Fixed a) where
1377+ toJSON = Number . realToFrac
1378+ {-# INLINE toJSON #-}
1379+
1380+ toEncoding = E.scientific . realToFrac
1381+ {-# INLINE toEncoding #-}
1382+
1383+instance HasResolution a => ToJSONKey (Fixed a) where
1384+ toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)
1385+ {-# INLINE toJSONKey #-}
1386+
1387+
1388+instance ToJSON Int where
1389+ toJSON = Number . fromIntegral
1390+ {-# INLINE toJSON #-}
1391+
1392+ toEncoding = E.int
1393+ {-# INLINE toEncoding #-}
1394+
1395+instance ToJSONKey Int where
1396+ toJSONKey = toJSONKeyTextEnc E.intText
1397+ {-# INLINE toJSONKey #-}
1398+
1399+
1400+instance ToJSON Integer where
1401+ toJSON = Number . fromInteger
1402+ {-# INLINE toJSON #-}
1403+
1404+ toEncoding = E.integer
1405+ {-# INLINE toEncoding #-}
1406+
1407+instance ToJSONKey Integer where
1408+ toJSONKey = toJSONKeyTextEnc E.integerText
1409+ {-# INLINE toJSONKey #-}
1410+
1411+
1412+instance ToJSON Natural where
1413+ toJSON = toJSON . toInteger
1414+ {-# INLINE toJSON #-}
1415+
1416+ toEncoding = toEncoding . toInteger
1417+ {-# INLINE toEncoding #-}
1418+
1419+instance ToJSONKey Natural where
1420+ toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)
1421+ {-# INLINE toJSONKey #-}
1422+
1423+
1424+instance ToJSON Int8 where
1425+ toJSON = Number . fromIntegral
1426+ {-# INLINE toJSON #-}
1427+
1428+ toEncoding = E.int8
1429+ {-# INLINE toEncoding #-}
1430+
1431+instance ToJSONKey Int8 where
1432+ toJSONKey = toJSONKeyTextEnc E.int8Text
1433+ {-# INLINE toJSONKey #-}
1434+
1435+
1436+instance ToJSON Int16 where
1437+ toJSON = Number . fromIntegral
1438+ {-# INLINE toJSON #-}
1439+
1440+ toEncoding = E.int16
1441+ {-# INLINE toEncoding #-}
1442+
1443+instance ToJSONKey Int16 where
1444+ toJSONKey = toJSONKeyTextEnc E.int16Text
1445+ {-# INLINE toJSONKey #-}
1446+
1447+
1448+instance ToJSON Int32 where
1449+ toJSON = Number . fromIntegral
1450+ {-# INLINE toJSON #-}
1451+
1452+ toEncoding = E.int32
1453+ {-# INLINE toEncoding #-}
1454+
1455+instance ToJSONKey Int32 where
1456+ toJSONKey = toJSONKeyTextEnc E.int32Text
1457+ {-# INLINE toJSONKey #-}
1458+
1459+
1460+instance ToJSON Int64 where
1461+ toJSON = Number . fromIntegral
1462+ {-# INLINE toJSON #-}
1463+
1464+ toEncoding = E.int64
1465+ {-# INLINE toEncoding #-}
1466+
1467+instance ToJSONKey Int64 where
1468+ toJSONKey = toJSONKeyTextEnc E.int64Text
1469+ {-# INLINE toJSONKey #-}
1470+
1471+instance ToJSON Word where
1472+ toJSON = Number . fromIntegral
1473+ {-# INLINE toJSON #-}
1474+
1475+ toEncoding = E.word
1476+ {-# INLINE toEncoding #-}
1477+
1478+instance ToJSONKey Word where
1479+ toJSONKey = toJSONKeyTextEnc E.wordText
1480+ {-# INLINE toJSONKey #-}
1481+
1482+
1483+instance ToJSON Word8 where
1484+ toJSON = Number . fromIntegral
1485+ {-# INLINE toJSON #-}
1486+
1487+ toEncoding = E.word8
1488+ {-# INLINE toEncoding #-}
1489+
1490+instance ToJSONKey Word8 where
1491+ toJSONKey = toJSONKeyTextEnc E.word8Text
1492+ {-# INLINE toJSONKey #-}
1493+
1494+
1495+instance ToJSON Word16 where
1496+ toJSON = Number . fromIntegral
1497+ {-# INLINE toJSON #-}
1498+
1499+ toEncoding = E.word16
1500+ {-# INLINE toEncoding #-}
1501+
1502+instance ToJSONKey Word16 where
1503+ toJSONKey = toJSONKeyTextEnc E.word16Text
1504+ {-# INLINE toJSONKey #-}
1505+
1506+
1507+instance ToJSON Word32 where
1508+ toJSON = Number . fromIntegral
1509+ {-# INLINE toJSON #-}
1510+
1511+ toEncoding = E.word32
1512+ {-# INLINE toEncoding #-}
1513+
1514+instance ToJSONKey Word32 where
1515+ toJSONKey = toJSONKeyTextEnc E.word32Text
1516+ {-# INLINE toJSONKey #-}
1517+
1518+
1519+instance ToJSON Word64 where
1520+ toJSON = Number . fromIntegral
1521+ {-# INLINE toJSON #-}
1522+
1523+ toEncoding = E.word64
1524+ {-# INLINE toEncoding #-}
1525+
1526+instance ToJSONKey Word64 where
1527+ toJSONKey = toJSONKeyTextEnc E.word64Text
1528+ {-# INLINE toJSONKey #-}
1529+
1530+instance ToJSON CTime where
1531+ toJSON (CTime i) = toJSON i
1532+ {-# INLINE toJSON #-}
1533+
1534+ toEncoding (CTime i) = toEncoding i
1535+ {-# INLINE toEncoding #-}
1536+
1537+instance ToJSON Text where
1538+ toJSON = String
1539+ {-# INLINE toJSON #-}
1540+
1541+ toEncoding = E.text
1542+ {-# INLINE toEncoding #-}
1543+
1544+instance ToJSONKey Text where
1545+ toJSONKey = toJSONKeyText id
1546+ {-# INLINE toJSONKey #-}
1547+
1548+
1549+instance ToJSON LT.Text where
1550+ toJSON = String . LT.toStrict
1551+ {-# INLINE toJSON #-}
1552+
1553+ toEncoding = E.lazyText
1554+ {-# INLINE toEncoding #-}
1555+
1556+instance ToJSONKey LT.Text where
1557+ toJSONKey = toJSONKeyText LT.toStrict
1558+
1559+
1560+instance ToJSON Version where
1561+ toJSON = toJSON . showVersion
1562+ {-# INLINE toJSON #-}
1563+
1564+ toEncoding = toEncoding . showVersion
1565+ {-# INLINE toEncoding #-}
1566+
1567+instance ToJSONKey Version where
1568+ toJSONKey = toJSONKeyText (T.pack . showVersion)
1569+
1570+-------------------------------------------------------------------------------
1571+-- semigroups NonEmpty
1572+-------------------------------------------------------------------------------
1573+
1574+instance ToJSON1 NonEmpty where
1575+ liftToJSON t _ = listValue t . NE.toList
1576+ {-# INLINE liftToJSON #-}
1577+
1578+ liftToEncoding t _ = listEncoding t . NE.toList
1579+ {-# INLINE liftToEncoding #-}
1580+
1581+instance (ToJSON a) => ToJSON (NonEmpty a) where
1582+ toJSON = toJSON1
1583+ {-# INLINE toJSON #-}
1584+
1585+ toEncoding = toEncoding1
1586+ {-# INLINE toEncoding #-}
1587+
1588+-------------------------------------------------------------------------------
1589+-- scientific
1590+-------------------------------------------------------------------------------
1591+
1592+instance ToJSON Scientific where
1593+ toJSON = Number
1594+ {-# INLINE toJSON #-}
1595+
1596+ toEncoding = E.scientific
1597+ {-# INLINE toEncoding #-}
1598+
1599+instance ToJSONKey Scientific where
1600+ toJSONKey = toJSONKeyTextEnc E.scientificText
1601+
1602+-------------------------------------------------------------------------------
1603+-- DList
1604+-------------------------------------------------------------------------------
1605+
1606+instance ToJSON1 DList.DList where
1607+ liftToJSON t _ = listValue t . toList
1608+ {-# INLINE liftToJSON #-}
1609+
1610+ liftToEncoding t _ = listEncoding t . toList
1611+ {-# INLINE liftToEncoding #-}
1612+
1613+instance (ToJSON a) => ToJSON (DList.DList a) where
1614+ toJSON = toJSON1
1615+ {-# INLINE toJSON #-}
1616+
1617+ toEncoding = toEncoding1
1618+ {-# INLINE toEncoding #-}
1619+
1620+-------------------------------------------------------------------------------
1621+-- transformers - Functors
1622+-------------------------------------------------------------------------------
1623+
1624+instance ToJSON1 Identity where
1625+ liftToJSON t _ (Identity a) = t a
1626+ {-# INLINE liftToJSON #-}
1627+
1628+ liftToJSONList _ tl xs = tl (map runIdentity xs)
1629+ {-# INLINE liftToJSONList #-}
1630+
1631+ liftToEncoding t _ (Identity a) = t a
1632+ {-# INLINE liftToEncoding #-}
1633+
1634+ liftToEncodingList _ tl xs = tl (map runIdentity xs)
1635+ {-# INLINE liftToEncodingList #-}
1636+
1637+instance (ToJSON a) => ToJSON (Identity a) where
1638+ toJSON = toJSON1
1639+ {-# INLINE toJSON #-}
1640+
1641+ toJSONList = liftToJSONList toJSON toJSONList
1642+ {-# INLINE toJSONList #-}
1643+
1644+ toEncoding = toEncoding1
1645+ {-# INLINE toEncoding #-}
1646+
1647+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1648+ {-# INLINE toEncodingList #-}
1649+
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
1651+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652+ toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1653+
1654+
1655+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1656+ liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1657+ where
1658+ g = liftToJSON tv tvl
1659+ gl = liftToJSONList tv tvl
1660+ {-# INLINE liftToJSON #-}
1661+
1662+ liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1663+ where
1664+ g = liftToJSON te tel
1665+ gl = liftToJSONList te tel
1666+ {-# INLINE liftToJSONList #-}
1667+
1668+ liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1669+ where
1670+ g = liftToEncoding te tel
1671+ gl = liftToEncodingList te tel
1672+ {-# INLINE liftToEncoding #-}
1673+
1674+ liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1675+ where
1676+ g = liftToEncoding te tel
1677+ gl = liftToEncodingList te tel
1678+ {-# INLINE liftToEncodingList #-}
1679+
1680+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1681+ toJSON = toJSON1
1682+ {-# INLINE toJSON #-}
1683+
1684+ toJSONList = liftToJSONList toJSON toJSONList
1685+ {-# INLINE toJSONList #-}
1686+
1687+ toEncoding = toEncoding1
1688+ {-# INLINE toEncoding #-}
1689+
1690+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1691+ {-# INLINE toEncodingList #-}
1692+
1693+
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)
1696+ where
1697+ tx = liftToJSON tv tvl
1698+ txl = liftToJSONList tv tvl
1699+ ty = liftToJSON tv tvl
1700+ tyl = liftToJSONList tv tvl
1701+
1702+ liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
1703+ where
1704+ tx = liftToEncoding te tel
1705+ txl = liftToEncodingList te tel
1706+ ty = liftToEncoding te tel
1707+ tyl = liftToEncodingList te tel
1708+
1709+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
1710+ toJSON = toJSON1
1711+ {-# INLINE toJSON #-}
1712+
1713+ toEncoding = toEncoding1
1714+ {-# INLINE toEncoding #-}
1715+
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)
1719+
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
1722+
1723+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
1724+ toJSON = toJSON1
1725+ {-# INLINE toJSON #-}
1726+
1727+ toEncoding = toEncoding1
1728+ {-# INLINE toEncoding #-}
1729+
1730+-------------------------------------------------------------------------------
1731+-- containers
1732+-------------------------------------------------------------------------------
1733+
1734+instance ToJSON1 Seq.Seq where
1735+ liftToJSON t _ = listValue t . toList
1736+ {-# INLINE liftToJSON #-}
1737+
1738+ liftToEncoding t _ = listEncoding t . toList
1739+ {-# INLINE liftToEncoding #-}
1740+
1741+instance (ToJSON a) => ToJSON (Seq.Seq a) where
1742+ toJSON = toJSON1
1743+ {-# INLINE toJSON #-}
1744+
1745+ toEncoding = toEncoding1
1746+ {-# INLINE toEncoding #-}
1747+
1748+
1749+instance ToJSON1 Set.Set where
1750+ liftToJSON t _ = listValue t . Set.toList
1751+ {-# INLINE liftToJSON #-}
1752+
1753+ liftToEncoding t _ = listEncoding t . Set.toList
1754+ {-# INLINE liftToEncoding #-}
1755+
1756+instance (ToJSON a) => ToJSON (Set.Set a) where
1757+ toJSON = toJSON1
1758+ {-# INLINE toJSON #-}
1759+
1760+ toEncoding = toEncoding1
1761+ {-# INLINE toEncoding #-}
1762+
1763+
1764+instance ToJSON IntSet.IntSet where
1765+ toJSON = toJSON . IntSet.toList
1766+ {-# INLINE toJSON #-}
1767+
1768+ toEncoding = toEncoding . IntSet.toList
1769+ {-# INLINE toEncoding #-}
1770+
1771+
1772+instance ToJSON1 IntMap.IntMap where
1773+ liftToJSON t tol = liftToJSON to' tol' . IntMap.toList
1774+ where
1775+ to' = liftToJSON2 toJSON toJSONList t tol
1776+ tol' = liftToJSONList2 toJSON toJSONList t tol
1777+ {-# INLINE liftToJSON #-}
1778+
1779+ liftToEncoding t tol = liftToEncoding to' tol' . IntMap.toList
1780+ where
1781+ to' = liftToEncoding2 toEncoding toEncodingList t tol
1782+ tol' = liftToEncodingList2 toEncoding toEncodingList t tol
1783+ {-# INLINE liftToEncoding #-}
1784+
1785+instance ToJSON a => ToJSON (IntMap.IntMap a) where
1786+ toJSON = toJSON1
1787+ {-# INLINE toJSON #-}
1788+
1789+ toEncoding = toEncoding1
1790+ {-# INLINE toEncoding #-}
1791+
1792+
1793+instance ToJSONKey k => ToJSON1 (M.Map k) where
1794+ liftToJSON g _ = case toJSONKey of
1795+ ToJSONKeyText f _ -> Object . mapHashKeyVal f g
1796+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
1797+ {-# INLINE liftToJSON #-}
1798+
1799+ liftToEncoding g _ = case toJSONKey of
1800+ ToJSONKeyText _ f -> dict f g M.foldrWithKey
1801+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1802+ where
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
1804+ {-# INLINE liftToEncoding #-}
1805+
1806+
1807+instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
1808+ toJSON = toJSON1
1809+ {-# INLINE toJSON #-}
1810+
1811+ toEncoding = toEncoding1
1812+ {-# INLINE toEncoding #-}
1813+
1814+
1815+instance ToJSON1 Tree.Tree where
1816+ liftToJSON t tol = go
1817+ where
1818+ go (Tree.Node root branches) =
1819+ liftToJSON2 t tol to' tol' (root, branches)
1820+
1821+ to' = liftToJSON go (listValue go)
1822+ tol' = liftToJSONList go (listValue go)
1823+ {-# INLINE liftToJSON #-}
1824+
1825+ liftToEncoding t tol = go
1826+ where
1827+ go (Tree.Node root branches) =
1828+ liftToEncoding2 t tol to' tol' (root, branches)
1829+
1830+ to' = liftToEncoding go (listEncoding go)
1831+ tol' = liftToEncodingList go (listEncoding go)
1832+ {-# INLINE liftToEncoding #-}
1833+
1834+instance (ToJSON v) => ToJSON (Tree.Tree v) where
1835+ toJSON = toJSON1
1836+ {-# INLINE toJSON #-}
1837+
1838+ toEncoding = toEncoding1
1839+ {-# INLINE toEncoding #-}
1840+
1841+-------------------------------------------------------------------------------
1842+-- uuid
1843+-------------------------------------------------------------------------------
1844+
1845+instance ToJSON UUID.UUID where
1846+ toJSON = toJSON . UUID.toText
1847+ toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1848+
1849+instance ToJSONKey UUID.UUID where
1850+ toJSONKey = ToJSONKeyText UUID.toText $
1851+ E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1852+
1853+-------------------------------------------------------------------------------
1854+-- vector
1855+-------------------------------------------------------------------------------
1856+
1857+instance ToJSON1 Vector where
1858+ liftToJSON t _ = Array . V.map t
1859+ {-# INLINE liftToJSON #-}
1860+
1861+ liftToEncoding t _ = listEncoding t . V.toList
1862+ {-# INLINE liftToEncoding #-}
1863+
1864+instance (ToJSON a) => ToJSON (Vector a) where
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1866+
1867+ toJSON = toJSON1
1868+ {-# INLINE toJSON #-}
1869+
1870+ toEncoding = toEncoding1
1871+ {-# INLINE toEncoding #-}
1872+
1873+encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1874+encodeVector = listEncoding toEncoding . VG.toList
1875+{-# INLINE encodeVector #-}
1876+
1877+vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
1878+vectorToJSON = Array . V.map toJSON . V.convert
1879+{-# INLINE vectorToJSON #-}
1880+
1881+instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
1882+ toJSON = vectorToJSON
1883+ {-# INLINE toJSON #-}
1884+
1885+ toEncoding = encodeVector
1886+ {-# INLINE toEncoding #-}
1887+
1888+
1889+instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
1890+ toJSON = vectorToJSON
1891+ {-# INLINE toJSON #-}
1892+
1893+ toEncoding = encodeVector
1894+ {-# INLINE toEncoding #-}
1895+
1896+
1897+instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
1898+ toJSON = vectorToJSON
1899+ {-# INLINE toJSON #-}
1900+
1901+ toEncoding = encodeVector
1902+ {-# INLINE toEncoding #-}
1903+
1904+-------------------------------------------------------------------------------
1905+-- unordered-containers
1906+-------------------------------------------------------------------------------
1907+
1908+instance ToJSON1 HashSet.HashSet where
1909+ liftToJSON t _ = listValue t . HashSet.toList
1910+ {-# INLINE liftToJSON #-}
1911+
1912+ liftToEncoding t _ = listEncoding t . HashSet.toList
1913+ {-# INLINE liftToEncoding #-}
1914+
1915+instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
1916+ toJSON = toJSON1
1917+ {-# INLINE toJSON #-}
1918+
1919+ toEncoding = toEncoding1
1920+ {-# INLINE toEncoding #-}
1921+
1922+
1923+instance ToJSONKey k => ToJSON1 (H.HashMap k) where
1924+ liftToJSON g _ = case toJSONKey of
1925+ ToJSONKeyText f _ -> Object . mapKeyVal f g
1926+ ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
1927+ {-# INLINE liftToJSON #-}
1928+
1929+ -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding
1930+ liftToEncoding g _ = case toJSONKey of
1931+ ToJSONKeyText _ f -> dict f g H.foldrWithKey
1932+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
1933+ where
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
1935+ {-# INLINE liftToEncoding #-}
1936+
1937+instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938+ {-# SPECIALIZE instance ToJSON Object #-}
1939+
1940+ toJSON = toJSON1
1941+ {-# INLINE toJSON #-}
1942+
1943+ toEncoding = toEncoding1
1944+ {-# INLINE toEncoding #-}
1945+
1946+-------------------------------------------------------------------------------
1947+-- aeson
1948+-------------------------------------------------------------------------------
1949+
1950+instance ToJSON Value where
1951+ toJSON a = a
1952+ {-# INLINE toJSON #-}
1953+
1954+ toEncoding = E.value
1955+ {-# INLINE toEncoding #-}
1956+
1957+instance ToJSON DotNetTime where
1958+ toJSON = toJSON . dotNetTime
1959+
1960+ toEncoding = toEncoding . dotNetTime
1961+
1962+dotNetTime :: DotNetTime -> String
1963+dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1964+ where secs = formatTime defaultTimeLocale "/Date(%s" t
1965+
1966+formatMillis :: (FormatTime t) => t -> String
1967+formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1968+
1969+-------------------------------------------------------------------------------
1970+-- primitive
1971+-------------------------------------------------------------------------------
1972+
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
1978+
1979+instance ToJSON a => ToJSON (PM.SmallArray a) where
1980+ toJSON = toJSON . Exts.toList
1981+ toEncoding = toEncoding . Exts.toList
1982+
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
1987+
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
1992+#endif
1993+#endif
1994+
1995+-------------------------------------------------------------------------------
1996+-- time
1997+-------------------------------------------------------------------------------
1998+
1999+instance ToJSON Day where
2000+ toJSON = stringEncoding . E.day
2001+ toEncoding = E.day
2002+
2003+instance ToJSONKey Day where
2004+ toJSONKey = toJSONKeyTextEnc E.day
2005+
2006+
2007+instance ToJSON TimeOfDay where
2008+ toJSON = stringEncoding . E.timeOfDay
2009+ toEncoding = E.timeOfDay
2010+
2011+instance ToJSONKey TimeOfDay where
2012+ toJSONKey = toJSONKeyTextEnc E.timeOfDay
2013+
2014+
2015+instance ToJSON LocalTime where
2016+ toJSON = stringEncoding . E.localTime
2017+ toEncoding = E.localTime
2018+
2019+instance ToJSONKey LocalTime where
2020+ toJSONKey = toJSONKeyTextEnc E.localTime
2021+
2022+
2023+instance ToJSON ZonedTime where
2024+ toJSON = stringEncoding . E.zonedTime
2025+ toEncoding = E.zonedTime
2026+
2027+instance ToJSONKey ZonedTime where
2028+ toJSONKey = toJSONKeyTextEnc E.zonedTime
2029+
2030+
2031+instance ToJSON UTCTime where
2032+ toJSON = stringEncoding . E.utcTime
2033+ toEncoding = E.utcTime
2034+
2035+instance ToJSONKey UTCTime where
2036+ toJSONKey = toJSONKeyTextEnc E.utcTime
2037+
2038+-- | Encode something t a JSON string.
2039+stringEncoding :: Encoding' Text -> Value
2040+stringEncoding = String
2041+ . T.dropAround (== '"')
2042+ . T.decodeLatin1
2043+ . L.toStrict
2044+ . E.encodingToLazyByteString
2045+{-# INLINE stringEncoding #-}
2046+
2047+
2048+instance ToJSON NominalDiffTime where
2049+ toJSON = Number . realToFrac
2050+ {-# INLINE toJSON #-}
2051+
2052+ toEncoding = E.scientific . realToFrac
2053+ {-# INLINE toEncoding #-}
2054+
2055+
2056+instance ToJSON DiffTime where
2057+ toJSON = Number . realToFrac
2058+ {-# INLINE toJSON #-}
2059+
2060+ toEncoding = E.scientific . realToFrac
2061+ {-# INLINE toEncoding #-}
2062+
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)
2069+
2070+instance ToJSON CalendarDiffTime where
2071+ toJSON (CalendarDiffTime m nt) = object
2072+ [ "months" .= m
2073+ , "time" .= nt
2074+ ]
2075+ toEncoding (CalendarDiffTime m nt) = E.pairs
2076+ ("months" .= m <> "time" .= nt)
2077+
2078+instance ToJSON CalendarDiffDays where
2079+ toJSON (CalendarDiffDays m d) = object
2080+ [ "months" .= m
2081+ , "days" .= d
2082+ ]
2083+ toEncoding (CalendarDiffDays m d) = E.pairs
2084+ ("months" .= m <> "days" .= d)
2085+
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"
2094+
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\""
2103+
2104+instance ToJSONKey DayOfWeek where
2105+ toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek
2106+
2107+-------------------------------------------------------------------------------
2108+-- base Monoid/Semigroup
2109+-------------------------------------------------------------------------------
2110+
2111+instance ToJSON1 Monoid.Dual where
2112+ liftToJSON t _ = t . Monoid.getDual
2113+ {-# INLINE liftToJSON #-}
2114+
2115+ liftToEncoding t _ = t . Monoid.getDual
2116+ {-# INLINE liftToEncoding #-}
2117+
2118+instance ToJSON a => ToJSON (Monoid.Dual a) where
2119+ toJSON = toJSON1
2120+ {-# INLINE toJSON #-}
2121+
2122+ toEncoding = toEncoding1
2123+ {-# INLINE toEncoding #-}
2124+
2125+
2126+instance ToJSON1 Monoid.First where
2127+ liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
2128+ {-# INLINE liftToJSON #-}
2129+
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
2131+ {-# INLINE liftToEncoding #-}
2132+
2133+instance ToJSON a => ToJSON (Monoid.First a) where
2134+ toJSON = toJSON1
2135+ {-# INLINE toJSON #-}
2136+
2137+ toEncoding = toEncoding1
2138+ {-# INLINE toEncoding #-}
2139+
2140+
2141+instance ToJSON1 Monoid.Last where
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2143+ {-# INLINE liftToJSON #-}
2144+
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2146+ {-# INLINE liftToEncoding #-}
2147+
2148+instance ToJSON a => ToJSON (Monoid.Last a) where
2149+ toJSON = toJSON1
2150+ {-# INLINE toJSON #-}
2151+
2152+ toEncoding = toEncoding1
2153+ {-# INLINE toEncoding #-}
2154+
2155+
2156+instance ToJSON1 Semigroup.Min where
2157+ liftToJSON t _ (Semigroup.Min x) = t x
2158+ {-# INLINE liftToJSON #-}
2159+
2160+ liftToEncoding t _ (Semigroup.Min x) = t x
2161+ {-# INLINE liftToEncoding #-}
2162+
2163+instance ToJSON a => ToJSON (Semigroup.Min a) where
2164+ toJSON = toJSON1
2165+ {-# INLINE toJSON #-}
2166+
2167+ toEncoding = toEncoding1
2168+ {-# INLINE toEncoding #-}
2169+
2170+
2171+instance ToJSON1 Semigroup.Max where
2172+ liftToJSON t _ (Semigroup.Max x) = t x
2173+ {-# INLINE liftToJSON #-}
2174+
2175+ liftToEncoding t _ (Semigroup.Max x) = t x
2176+ {-# INLINE liftToEncoding #-}
2177+
2178+instance ToJSON a => ToJSON (Semigroup.Max a) where
2179+ toJSON = toJSON1
2180+ {-# INLINE toJSON #-}
2181+
2182+ toEncoding = toEncoding1
2183+ {-# INLINE toEncoding #-}
2184+
2185+instance ToJSON1 Semigroup.First where
2186+ liftToJSON t _ (Semigroup.First x) = t x
2187+ {-# INLINE liftToJSON #-}
2188+
2189+ liftToEncoding t _ (Semigroup.First x) = t x
2190+ {-# INLINE liftToEncoding #-}
2191+
2192+instance ToJSON a => ToJSON (Semigroup.First a) where
2193+ toJSON = toJSON1
2194+ {-# INLINE toJSON #-}
2195+
2196+ toEncoding = toEncoding1
2197+ {-# INLINE toEncoding #-}
2198+
2199+
2200+instance ToJSON1 Semigroup.Last where
2201+ liftToJSON t _ (Semigroup.Last x) = t x
2202+ {-# INLINE liftToJSON #-}
2203+
2204+ liftToEncoding t _ (Semigroup.Last x) = t x
2205+ {-# INLINE liftToEncoding #-}
2206+
2207+instance ToJSON a => ToJSON (Semigroup.Last a) where
2208+ toJSON = toJSON1
2209+ {-# INLINE toJSON #-}
2210+
2211+ toEncoding = toEncoding1
2212+ {-# INLINE toEncoding #-}
2213+
2214+
2215+instance ToJSON1 Semigroup.WrappedMonoid where
2216+ liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217+ {-# INLINE liftToJSON #-}
2218+
2219+ liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220+ {-# INLINE liftToEncoding #-}
2221+
2222+instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2223+ toJSON = toJSON1
2224+ {-# INLINE toJSON #-}
2225+
2226+ toEncoding = toEncoding1
2227+ {-# INLINE toEncoding #-}
2228+
2229+
2230+instance ToJSON1 Semigroup.Option where
2231+ liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232+ {-# INLINE liftToJSON #-}
2233+
2234+ liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235+ {-# INLINE liftToEncoding #-}
2236+
2237+instance ToJSON a => ToJSON (Semigroup.Option a) where
2238+ toJSON = toJSON1
2239+ {-# INLINE toJSON #-}
2240+
2241+ toEncoding = toEncoding1
2242+ {-# INLINE toEncoding #-}
2243+
2244+-------------------------------------------------------------------------------
2245+-- tagged
2246+-------------------------------------------------------------------------------
2247+
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2251+
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
2254+
2255+instance ToJSON (Proxy a) where
2256+ toJSON _ = Null
2257+ {-# INLINE toJSON #-}
2258+
2259+ toEncoding _ = E.null_
2260+ {-# INLINE toEncoding #-}
2261+
2262+
2263+instance ToJSON2 Tagged where
2264+ liftToJSON2 _ _ t _ (Tagged x) = t x
2265+ {-# INLINE liftToJSON2 #-}
2266+
2267+ liftToEncoding2 _ _ t _ (Tagged x) = t x
2268+ {-# INLINE liftToEncoding2 #-}
2269+
2270+instance ToJSON1 (Tagged a) where
2271+ liftToJSON t _ (Tagged x) = t x
2272+ {-# INLINE liftToJSON #-}
2273+
2274+ liftToEncoding t _ (Tagged x) = t x
2275+ {-# INLINE liftToEncoding #-}
2276+
2277+instance ToJSON b => ToJSON (Tagged a b) where
2278+ toJSON = toJSON1
2279+ {-# INLINE toJSON #-}
2280+
2281+ toEncoding = toEncoding1
2282+ {-# INLINE toEncoding #-}
2283+
2284+instance ToJSONKey b => ToJSONKey (Tagged a b) where
2285+ toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2286+ toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2287+
2288+-------------------------------------------------------------------------------
2289+-- Instances for converting t map keys
2290+-------------------------------------------------------------------------------
2291+
2292+instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
2293+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
2294+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
2295+
2296+instance ToJSONKey Char where
2297+ toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
2298+ toJSONKeyList = toJSONKeyText T.pack
2299+
2300+instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2301+ toJSONKey = toJSONKeyList
2302+
2303+-------------------------------------------------------------------------------
2304+-- Tuple instances
2305+-------------------------------------------------------------------------------
2306+
2307+instance ToJSON2 (,) where
2308+ liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
2309+ mv <- VM.unsafeNew 2
2310+ VM.unsafeWrite mv 0 (toA a)
2311+ VM.unsafeWrite mv 1 (toB b)
2312+ return mv
2313+ {-# INLINE liftToJSON2 #-}
2314+
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2316+ {-# INLINE liftToEncoding2 #-}
2317+
2318+instance (ToJSON a) => ToJSON1 ((,) a) where
2319+ liftToJSON = liftToJSON2 toJSON toJSONList
2320+ {-# INLINE liftToJSON #-}
2321+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2322+ {-# INLINE liftToEncoding #-}
2323+
2324+instance (ToJSON a, ToJSON b) => ToJSON (a, b) where
2325+ toJSON = toJSON2
2326+ {-# INLINE toJSON #-}
2327+ toEncoding = toEncoding2
2328+ {-# INLINE toEncoding #-}
2329+
2330+instance (ToJSON a) => ToJSON2 ((,,) a) where
2331+ liftToJSON2 toB _ toC _ (a, b, c) = Array $ V.create $ do
2332+ mv <- VM.unsafeNew 3
2333+ VM.unsafeWrite mv 0 (toJSON a)
2334+ VM.unsafeWrite mv 1 (toB b)
2335+ VM.unsafeWrite mv 2 (toC c)
2336+ return mv
2337+ {-# INLINE liftToJSON2 #-}
2338+
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2340+ [ toEncoding a
2341+ , toB b
2342+ , toC c
2343+ ]
2344+ {-# INLINE liftToEncoding2 #-}
2345+
2346+instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
2347+ liftToJSON = liftToJSON2 toJSON toJSONList
2348+ {-# INLINE liftToJSON #-}
2349+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2350+ {-# INLINE liftToEncoding #-}
2351+
2352+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) where
2353+ toJSON = toJSON2
2354+ {-# INLINE toJSON #-}
2355+ toEncoding = toEncoding2
2356+ {-# INLINE toEncoding #-}
2357+
2358+instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
2359+ liftToJSON2 toC _ toD _ (a, b, c, d) = Array $ V.create $ do
2360+ mv <- VM.unsafeNew 4
2361+ VM.unsafeWrite mv 0 (toJSON a)
2362+ VM.unsafeWrite mv 1 (toJSON b)
2363+ VM.unsafeWrite mv 2 (toC c)
2364+ VM.unsafeWrite mv 3 (toD d)
2365+ return mv
2366+ {-# INLINE liftToJSON2 #-}
2367+
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2369+ [ toEncoding a
2370+ , toEncoding b
2371+ , toC c
2372+ , toD d
2373+ ]
2374+ {-# INLINE liftToEncoding2 #-}
2375+
2376+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
2377+ liftToJSON = liftToJSON2 toJSON toJSONList
2378+ {-# INLINE liftToJSON #-}
2379+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2380+ {-# INLINE liftToEncoding #-}
2381+
2382+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) where
2383+ toJSON = toJSON2
2384+ {-# INLINE toJSON #-}
2385+ toEncoding = toEncoding2
2386+ {-# INLINE toEncoding #-}
2387+
2388+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
2389+ liftToJSON2 toD _ toE _ (a, b, c, d, e) = Array $ V.create $ do
2390+ mv <- VM.unsafeNew 5
2391+ VM.unsafeWrite mv 0 (toJSON a)
2392+ VM.unsafeWrite mv 1 (toJSON b)
2393+ VM.unsafeWrite mv 2 (toJSON c)
2394+ VM.unsafeWrite mv 3 (toD d)
2395+ VM.unsafeWrite mv 4 (toE e)
2396+ return mv
2397+ {-# INLINE liftToJSON2 #-}
2398+
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2400+ [ toEncoding a
2401+ , toEncoding b
2402+ , toEncoding c
2403+ , toD d
2404+ , toE e
2405+ ]
2406+ {-# INLINE liftToEncoding2 #-}
2407+
2408+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
2409+ liftToJSON = liftToJSON2 toJSON toJSONList
2410+ {-# INLINE liftToJSON #-}
2411+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2412+ {-# INLINE liftToEncoding #-}
2413+
2414+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) where
2415+ toJSON = toJSON2
2416+ {-# INLINE toJSON #-}
2417+ toEncoding = toEncoding2
2418+ {-# INLINE toEncoding #-}
2419+
2420+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) where
2421+ liftToJSON2 toE _ toF _ (a, b, c, d, e, f) = Array $ V.create $ do
2422+ mv <- VM.unsafeNew 6
2423+ VM.unsafeWrite mv 0 (toJSON a)
2424+ VM.unsafeWrite mv 1 (toJSON b)
2425+ VM.unsafeWrite mv 2 (toJSON c)
2426+ VM.unsafeWrite mv 3 (toJSON d)
2427+ VM.unsafeWrite mv 4 (toE e)
2428+ VM.unsafeWrite mv 5 (toF f)
2429+ return mv
2430+ {-# INLINE liftToJSON2 #-}
2431+
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2433+ [ toEncoding a
2434+ , toEncoding b
2435+ , toEncoding c
2436+ , toEncoding d
2437+ , toE e
2438+ , toF f
2439+ ]
2440+ {-# INLINE liftToEncoding2 #-}
2441+
2442+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
2443+ liftToJSON = liftToJSON2 toJSON toJSONList
2444+ {-# INLINE liftToJSON #-}
2445+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2446+ {-# INLINE liftToEncoding #-}
2447+
2448+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) where
2449+ toJSON = toJSON2
2450+ {-# INLINE toJSON #-}
2451+ toEncoding = toEncoding2
2452+ {-# INLINE toEncoding #-}
2453+
2454+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,) a b c d e) where
2455+ liftToJSON2 toF _ toG _ (a, b, c, d, e, f, g) = Array $ V.create $ do
2456+ mv <- VM.unsafeNew 7
2457+ VM.unsafeWrite mv 0 (toJSON a)
2458+ VM.unsafeWrite mv 1 (toJSON b)
2459+ VM.unsafeWrite mv 2 (toJSON c)
2460+ VM.unsafeWrite mv 3 (toJSON d)
2461+ VM.unsafeWrite mv 4 (toJSON e)
2462+ VM.unsafeWrite mv 5 (toF f)
2463+ VM.unsafeWrite mv 6 (toG g)
2464+ return mv
2465+ {-# INLINE liftToJSON2 #-}
2466+
2467+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2468+ [ toEncoding a
2469+ , toEncoding b
2470+ , toEncoding c
2471+ , toEncoding d
2472+ , toEncoding e
2473+ , toF f
2474+ , toG g
2475+ ]
2476+ {-# INLINE liftToEncoding2 #-}
2477+
2478+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
2479+ liftToJSON = liftToJSON2 toJSON toJSONList
2480+ {-# INLINE liftToJSON #-}
2481+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2482+ {-# INLINE liftToEncoding #-}
2483+
2484+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) where
2485+ toJSON = toJSON2
2486+ {-# INLINE toJSON #-}
2487+ toEncoding = toEncoding2
2488+ {-# INLINE toEncoding #-}
2489+
2490+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2 ((,,,,,,,) a b c d e f) where
2491+ liftToJSON2 toG _ toH _ (a, b, c, d, e, f, g, h) = Array $ V.create $ do
2492+ mv <- VM.unsafeNew 8
2493+ VM.unsafeWrite mv 0 (toJSON a)
2494+ VM.unsafeWrite mv 1 (toJSON b)
2495+ VM.unsafeWrite mv 2 (toJSON c)
2496+ VM.unsafeWrite mv 3 (toJSON d)
2497+ VM.unsafeWrite mv 4 (toJSON e)
2498+ VM.unsafeWrite mv 5 (toJSON f)
2499+ VM.unsafeWrite mv 6 (toG g)
2500+ VM.unsafeWrite mv 7 (toH h)
2501+ return mv
2502+ {-# INLINE liftToJSON2 #-}
2503+
2504+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2505+ [ toEncoding a
2506+ , toEncoding b
2507+ , toEncoding c
2508+ , toEncoding d
2509+ , toEncoding e
2510+ , toEncoding f
2511+ , toG g
2512+ , toH h
2513+ ]
2514+ {-# INLINE liftToEncoding2 #-}
2515+
2516+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
2517+ liftToJSON = liftToJSON2 toJSON toJSONList
2518+ {-# INLINE liftToJSON #-}
2519+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2520+ {-# INLINE liftToEncoding #-}
2521+
2522+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON (a, b, c, d, e, f, g, h) where
2523+ toJSON = toJSON2
2524+ {-# INLINE toJSON #-}
2525+ toEncoding = toEncoding2
2526+ {-# INLINE toEncoding #-}
2527+
2528+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON2 ((,,,,,,,,) a b c d e f g) where
2529+ liftToJSON2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = Array $ V.create $ do
2530+ mv <- VM.unsafeNew 9
2531+ VM.unsafeWrite mv 0 (toJSON a)
2532+ VM.unsafeWrite mv 1 (toJSON b)
2533+ VM.unsafeWrite mv 2 (toJSON c)
2534+ VM.unsafeWrite mv 3 (toJSON d)
2535+ VM.unsafeWrite mv 4 (toJSON e)
2536+ VM.unsafeWrite mv 5 (toJSON f)
2537+ VM.unsafeWrite mv 6 (toJSON g)
2538+ VM.unsafeWrite mv 7 (toH h)
2539+ VM.unsafeWrite mv 8 (toI i)
2540+ return mv
2541+ {-# INLINE liftToJSON2 #-}
2542+
2543+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2544+ [ toEncoding a
2545+ , toEncoding b
2546+ , toEncoding c
2547+ , toEncoding d
2548+ , toEncoding e
2549+ , toEncoding f
2550+ , toEncoding g
2551+ , toH h
2552+ , toI i
2553+ ]
2554+ {-# INLINE liftToEncoding2 #-}
2555+
2556+instance (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
2557+ liftToJSON = liftToJSON2 toJSON toJSONList
2558+ {-# INLINE liftToJSON #-}
2559+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2560+ {-# INLINE liftToEncoding #-}
2561+
2562+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON (a, b, c, d, e, f, g, h, i) where
2563+ toJSON = toJSON2
2564+ {-# INLINE toJSON #-}
2565+ toEncoding = toEncoding2
2566+ {-# INLINE toEncoding #-}
2567+
2568+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON2 ((,,,,,,,,,) a b c d e f g h) where
2569+ liftToJSON2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = Array $ V.create $ do
2570+ mv <- VM.unsafeNew 10
2571+ VM.unsafeWrite mv 0 (toJSON a)
2572+ VM.unsafeWrite mv 1 (toJSON b)
2573+ VM.unsafeWrite mv 2 (toJSON c)
2574+ VM.unsafeWrite mv 3 (toJSON d)
2575+ VM.unsafeWrite mv 4 (toJSON e)
2576+ VM.unsafeWrite mv 5 (toJSON f)
2577+ VM.unsafeWrite mv 6 (toJSON g)
2578+ VM.unsafeWrite mv 7 (toJSON h)
2579+ VM.unsafeWrite mv 8 (toI i)
2580+ VM.unsafeWrite mv 9 (toJ j)
2581+ return mv
2582+ {-# INLINE liftToJSON2 #-}
2583+
2584+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2585+ [ toEncoding a
2586+ , toEncoding b
2587+ , toEncoding c
2588+ , toEncoding d
2589+ , toEncoding e
2590+ , toEncoding f
2591+ , toEncoding g
2592+ , toEncoding h
2593+ , toI i
2594+ , toJ j
2595+ ]
2596+ {-# INLINE liftToEncoding2 #-}
2597+
2598+instance (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
2599+ liftToJSON = liftToJSON2 toJSON toJSONList
2600+ {-# INLINE liftToJSON #-}
2601+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2602+ {-# INLINE liftToEncoding #-}
2603+
2604+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON (a, b, c, d, e, f, g, h, i, j) where
2605+ toJSON = toJSON2
2606+ {-# INLINE toJSON #-}
2607+ toEncoding = toEncoding2
2608+ {-# INLINE toEncoding #-}
2609+
2610+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON2 ((,,,,,,,,,,) a b c d e f g h i) where
2611+ liftToJSON2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = Array $ V.create $ do
2612+ mv <- VM.unsafeNew 11
2613+ VM.unsafeWrite mv 0 (toJSON a)
2614+ VM.unsafeWrite mv 1 (toJSON b)
2615+ VM.unsafeWrite mv 2 (toJSON c)
2616+ VM.unsafeWrite mv 3 (toJSON d)
2617+ VM.unsafeWrite mv 4 (toJSON e)
2618+ VM.unsafeWrite mv 5 (toJSON f)
2619+ VM.unsafeWrite mv 6 (toJSON g)
2620+ VM.unsafeWrite mv 7 (toJSON h)
2621+ VM.unsafeWrite mv 8 (toJSON i)
2622+ VM.unsafeWrite mv 9 (toJ j)
2623+ VM.unsafeWrite mv 10 (toK k)
2624+ return mv
2625+ {-# INLINE liftToJSON2 #-}
2626+
2627+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2628+ [ toEncoding a
2629+ , toEncoding b
2630+ , toEncoding c
2631+ , toEncoding d
2632+ , toEncoding e
2633+ , toEncoding f
2634+ , toEncoding g
2635+ , toEncoding h
2636+ , toEncoding i
2637+ , toJ j
2638+ , toK k
2639+ ]
2640+ {-# INLINE liftToEncoding2 #-}
2641+
2642+instance (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
2643+ liftToJSON = liftToJSON2 toJSON toJSONList
2644+ {-# INLINE liftToJSON #-}
2645+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2646+ {-# INLINE liftToEncoding #-}
2647+
2648+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON (a, b, c, d, e, f, g, h, i, j, k) where
2649+ toJSON = toJSON2
2650+ {-# INLINE toJSON #-}
2651+ toEncoding = toEncoding2
2652+ {-# INLINE toEncoding #-}
2653+
2654+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where
2655+ liftToJSON2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = Array $ V.create $ do
2656+ mv <- VM.unsafeNew 12
2657+ VM.unsafeWrite mv 0 (toJSON a)
2658+ VM.unsafeWrite mv 1 (toJSON b)
2659+ VM.unsafeWrite mv 2 (toJSON c)
2660+ VM.unsafeWrite mv 3 (toJSON d)
2661+ VM.unsafeWrite mv 4 (toJSON e)
2662+ VM.unsafeWrite mv 5 (toJSON f)
2663+ VM.unsafeWrite mv 6 (toJSON g)
2664+ VM.unsafeWrite mv 7 (toJSON h)
2665+ VM.unsafeWrite mv 8 (toJSON i)
2666+ VM.unsafeWrite mv 9 (toJSON j)
2667+ VM.unsafeWrite mv 10 (toK k)
2668+ VM.unsafeWrite mv 11 (toL l)
2669+ return mv
2670+ {-# INLINE liftToJSON2 #-}
2671+
2672+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2673+ [ toEncoding a
2674+ , toEncoding b
2675+ , toEncoding c
2676+ , toEncoding d
2677+ , toEncoding e
2678+ , toEncoding f
2679+ , toEncoding g
2680+ , toEncoding h
2681+ , toEncoding i
2682+ , toEncoding j
2683+ , toK k
2684+ , toL l
2685+ ]
2686+ {-# INLINE liftToEncoding2 #-}
2687+
2688+instance (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
2689+ liftToJSON = liftToJSON2 toJSON toJSONList
2690+ {-# INLINE liftToJSON #-}
2691+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2692+ {-# INLINE liftToEncoding #-}
2693+
2694+instance (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 (a, b, c, d, e, f, g, h, i, j, k, l) where
2695+ toJSON = toJSON2
2696+ {-# INLINE toJSON #-}
2697+ toEncoding = toEncoding2
2698+ {-# INLINE toEncoding #-}
2699+
2700+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where
2701+ liftToJSON2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = Array $ V.create $ do
2702+ mv <- VM.unsafeNew 13
2703+ VM.unsafeWrite mv 0 (toJSON a)
2704+ VM.unsafeWrite mv 1 (toJSON b)
2705+ VM.unsafeWrite mv 2 (toJSON c)
2706+ VM.unsafeWrite mv 3 (toJSON d)
2707+ VM.unsafeWrite mv 4 (toJSON e)
2708+ VM.unsafeWrite mv 5 (toJSON f)
2709+ VM.unsafeWrite mv 6 (toJSON g)
2710+ VM.unsafeWrite mv 7 (toJSON h)
2711+ VM.unsafeWrite mv 8 (toJSON i)
2712+ VM.unsafeWrite mv 9 (toJSON j)
2713+ VM.unsafeWrite mv 10 (toJSON k)
2714+ VM.unsafeWrite mv 11 (toL l)
2715+ VM.unsafeWrite mv 12 (toM m)
2716+ return mv
2717+ {-# INLINE liftToJSON2 #-}
2718+
2719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2720+ [ toEncoding a
2721+ , toEncoding b
2722+ , toEncoding c
2723+ , toEncoding d
2724+ , toEncoding e
2725+ , toEncoding f
2726+ , toEncoding g
2727+ , toEncoding h
2728+ , toEncoding i
2729+ , toEncoding j
2730+ , toEncoding k
2731+ , toL l
2732+ , toM m
2733+ ]
2734+ {-# INLINE liftToEncoding2 #-}
2735+
2736+instance (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
2737+ liftToJSON = liftToJSON2 toJSON toJSONList
2738+ {-# INLINE liftToJSON #-}
2739+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2740+ {-# INLINE liftToEncoding #-}
2741+
2742+instance (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 (a, b, c, d, e, f, g, h, i, j, k, l, m) where
2743+ toJSON = toJSON2
2744+ {-# INLINE toJSON #-}
2745+ toEncoding = toEncoding2
2746+ {-# INLINE toEncoding #-}
2747+
2748+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where
2749+ liftToJSON2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = Array $ V.create $ do
2750+ mv <- VM.unsafeNew 14
2751+ VM.unsafeWrite mv 0 (toJSON a)
2752+ VM.unsafeWrite mv 1 (toJSON b)
2753+ VM.unsafeWrite mv 2 (toJSON c)
2754+ VM.unsafeWrite mv 3 (toJSON d)
2755+ VM.unsafeWrite mv 4 (toJSON e)
2756+ VM.unsafeWrite mv 5 (toJSON f)
2757+ VM.unsafeWrite mv 6 (toJSON g)
2758+ VM.unsafeWrite mv 7 (toJSON h)
2759+ VM.unsafeWrite mv 8 (toJSON i)
2760+ VM.unsafeWrite mv 9 (toJSON j)
2761+ VM.unsafeWrite mv 10 (toJSON k)
2762+ VM.unsafeWrite mv 11 (toJSON l)
2763+ VM.unsafeWrite mv 12 (toM m)
2764+ VM.unsafeWrite mv 13 (toN n)
2765+ return mv
2766+ {-# INLINE liftToJSON2 #-}
2767+
2768+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2769+ [ toEncoding a
2770+ , toEncoding b
2771+ , toEncoding c
2772+ , toEncoding d
2773+ , toEncoding e
2774+ , toEncoding f
2775+ , toEncoding g
2776+ , toEncoding h
2777+ , toEncoding i
2778+ , toEncoding j
2779+ , toEncoding k
2780+ , toEncoding l
2781+ , toM m
2782+ , toN n
2783+ ]
2784+ {-# INLINE liftToEncoding2 #-}
2785+
2786+instance (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
2787+ liftToJSON = liftToJSON2 toJSON toJSONList
2788+ {-# INLINE liftToJSON #-}
2789+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2790+ {-# INLINE liftToEncoding #-}
2791+
2792+instance (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) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
2793+ toJSON = toJSON2
2794+ {-# INLINE toJSON #-}
2795+ toEncoding = toEncoding2
2796+ {-# INLINE toEncoding #-}
2797+
2798+instance (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) => ToJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
2799+ liftToJSON2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = Array $ V.create $ do
2800+ mv <- VM.unsafeNew 15
2801+ VM.unsafeWrite mv 0 (toJSON a)
2802+ VM.unsafeWrite mv 1 (toJSON b)
2803+ VM.unsafeWrite mv 2 (toJSON c)
2804+ VM.unsafeWrite mv 3 (toJSON d)
2805+ VM.unsafeWrite mv 4 (toJSON e)
2806+ VM.unsafeWrite mv 5 (toJSON f)
2807+ VM.unsafeWrite mv 6 (toJSON g)
2808+ VM.unsafeWrite mv 7 (toJSON h)
2809+ VM.unsafeWrite mv 8 (toJSON i)
2810+ VM.unsafeWrite mv 9 (toJSON j)
2811+ VM.unsafeWrite mv 10 (toJSON k)
2812+ VM.unsafeWrite mv 11 (toJSON l)
2813+ VM.unsafeWrite mv 12 (toJSON m)
2814+ VM.unsafeWrite mv 13 (toN n)
2815+ VM.unsafeWrite mv 14 (toO o)
2816+ return mv
2817+ {-# INLINE liftToJSON2 #-}
2818+
2819+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2820+ [ toEncoding a
2821+ , toEncoding b
2822+ , toEncoding c
2823+ , toEncoding d
2824+ , toEncoding e
2825+ , toEncoding f
2826+ , toEncoding g
2827+ , toEncoding h
2828+ , toEncoding i
2829+ , toEncoding j
2830+ , toEncoding k
2831+ , toEncoding l
2832+ , toEncoding m
2833+ , toN n
2834+ , toO o
2835+ ]
2836+ {-# INLINE liftToEncoding2 #-}
2837+
2838+instance (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
2839+ liftToJSON = liftToJSON2 toJSON toJSONList
2840+ {-# INLINE liftToJSON #-}
2841+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2842+ {-# INLINE liftToEncoding #-}
2843+
2844+instance (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, ToJSON o) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
2845+ toJSON = toJSON2
2846+ {-# INLINE toJSON #-}
2847+ toEncoding = toEncoding2
2848+ {-# INLINE toEncoding #-}
2849+
2850+--------------------------------------------------------------------------------
2851+
2852+-- | Wrap a list of pairs as an object.
2853+class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2854+ fromPairs :: pairs -> enc
2855+
2856+instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857+ fromPairs = E.pairs
2858+
2859+instance FromPairs Value (DList Pair) where
2860+ fromPairs = object . toList
2861+
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
2867+
2868+instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869+ pair k v = DList.singleton (pack k .= v)
2870+
2871+instance (e ~ Encoding) => KeyValuePair e Series where
2872+ pair = E.pairStr