@@ -0,0 +1,2872 @@
2+{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE EmptyDataDecls #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE FunctionalDependencies #-}
8+{-# LANGUAGE NoImplicitPrelude #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE PatternGuards #-}
11+{-# LANGUAGE PolyKinds #-}
12+{-# LANGUAGE RecordWildCards #-}
13+{-# LANGUAGE ScopedTypeVariables #-}
14+{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE UndecidableInstances #-}
17+#include "overlapping-compat.h"
18+#include "incoherent-compat.h"
20+-- TODO: Drop this when we remove support for Data.Attoparsec.Number
21+{-# OPTIONS_GHC -fno-warn-deprecations #-}
23+module Data.Aeson.Types.ToJSON
25+ -- * Core JSON classes
27+ -- * Liftings to unary and binary type constructors
34+ -- * Generic JSON classes
40+ , genericLiftToEncoding
41+ -- * Classes and types for map keys
43+ , ToJSONKeyFunction(..)
45+ , contramapToJSONKeyFunction
50+ -- * Object key-value pairs
54+ -- * Functions needed for documentation
55+ -- * Encoding functions
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 (..))
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
128+import qualified Data.Aeson.Encoding.Builder as EB
129+import qualified Data.ByteString.Builder as B
131+import qualified GHC.Exts as Exts
132+import qualified Data.Primitive.Array as PM
133+import qualified Data.Primitive.SmallArray as PM
134+import qualified Data.Primitive.Types as PM
136+#if MIN_VERSION_primitive(0,6,4)
137+#if !MIN_VERSION_primitive(0,7,0)
138+import qualified Data.Primitive.UnliftedArray as PM
140+import qualified Data.Primitive.PrimArray as PM
143+toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
144+toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
145+{-# INLINE toJSONPair #-}
147+realFloatToJSON :: RealFloat a => a -> Value
149+ | isNaN d || isInfinite d = Null
150+ | otherwise = Number $ Scientific.fromFloatDigits d
151+{-# INLINE realFloatToJSON #-}
153+-------------------------------------------------------------------------------
155+-------------------------------------------------------------------------------
157+-- | Class of generic representation types that can be converted to
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').
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
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
173+data ToArgs res arity a where
174+ NoToArgs :: ToArgs res Zero a
175+ To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
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
184+-- | A configurable generic JSON creator. This function applied to
185+-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
186+-- is an instance of 'Generic1'.
187+genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
188+ => Options -> (a -> Value) -> ([a] -> Value)
190+genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
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
199+-- | A configurable generic JSON encoder. This function applied to
200+-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
201+-- is an instance of 'Generic1'.
202+genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
203+ => Options -> (a -> Encoding) -> ([a] -> Encoding)
205+genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
207+-------------------------------------------------------------------------------
209+-------------------------------------------------------------------------------
211+-- | A type that can be converted to JSON.
213+-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
214+-- to) specify 'toEncoding'.
216+-- An example type and instance:
219+-- \-- Allow ourselves to write 'Text' literals.
220+-- {-\# LANGUAGE OverloadedStrings #-}
222+-- data Coord = Coord { x :: Double, y :: Double }
224+-- instance 'ToJSON' Coord where
225+-- 'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
227+-- 'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
230+-- Instead of manually writing your 'ToJSON' instance, there are two options
231+-- to do it automatically:
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.
237+-- * The compiler can provide a default generic implementation for
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):
246+-- {-\# LANGUAGE DeriveGeneric \#-}
248+-- import "GHC.Generics"
250+-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
252+-- instance 'ToJSON' Coord where
253+-- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
256+-- If on the other hand you wish to customize the generic decoding, you have
257+-- to implement both methods:
260+-- customOptions = 'defaultOptions'
261+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
264+-- instance 'ToJSON' Coord where
265+-- 'toJSON' = 'genericToJSON' customOptions
266+-- 'toEncoding' = 'genericToEncoding' customOptions
269+-- Previous versions of this library only had the 'toJSON' method. Adding
270+-- 'toEncoding' had two reasons:
272+-- 1. toEncoding is more efficient for the common case that the output of
273+-- 'toJSON' is directly serialized to a @ByteString@.
274+-- Further, expressing either method in terms of the other would be
277+-- 2. The choice of defaults allows a smooth transition for existing users:
278+-- Existing instances that do not define 'toEncoding' still
279+-- compile and have the correct semantics. This is ensured by making
280+-- the default implementation of 'toEncoding' use 'toJSON'. This produces
281+-- correct results, but since it performs an intermediate conversion to a
282+-- 'Value', it will be less efficient than directly emitting an 'Encoding'.
283+-- (this also means that specifying nothing more than
284+-- @instance ToJSON Coord@ would be sufficient as a generically decoding
285+-- instance, but there probably exists no good reason to not specify
286+-- 'toEncoding' in new instances.)
288+ -- | Convert a Haskell value to a JSON-friendly intermediate type.
289+ toJSON :: a -> Value
291+ default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
292+ toJSON = genericToJSON defaultOptions
294+ -- | Encode a Haskell value as JSON.
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
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.
308+ -- instance 'ToJSON' Coord where
309+ -- 'toEncoding' = 'genericToEncoding' 'defaultOptions'
312+ toEncoding :: a -> Encoding
313+ toEncoding = E.value . toJSON
314+ {-# INLINE toEncoding #-}
316+ toJSONList :: [a] -> Value
317+ toJSONList = listValue toJSON
318+ {-# INLINE toJSONList #-}
320+ toEncodingList :: [a] -> Encoding
321+ toEncodingList = listEncoding toEncoding
322+ {-# INLINE toEncodingList #-}
324+-------------------------------------------------------------------------------
325+-- Object key-value pairs
326+-------------------------------------------------------------------------------
328+-- | A key-value pair for encoding a JSON object.
329+class KeyValue kv where
330+ (.=) :: ToJSON v => Text -> v -> kv
333+instance KeyValue Series where
334+ name .= value = E.pair name (toEncoding value)
337+instance KeyValue Pair where
338+ name .= value = (name, toJSON value)
341+-- | Constructs a singleton 'H.HashMap'. For calling functions that
342+-- demand an 'Object' for constructing objects. To be used in
343+-- conjunction with 'mconcat'. Prefer to use 'object' where possible.
344+instance KeyValue Object where
345+ name .= value = H.singleton name (toJSON value)
348+-------------------------------------------------------------------------------
349+-- Classes and types for map keys
350+-------------------------------------------------------------------------------
352+-- | Typeclass for types that can be used as the key of a map-like container
353+-- (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
354+-- instance and 'Char' has a 'ToJSON' instance, we can encode a value of
355+-- type 'Map' 'Text' 'Char':
357+-- >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
360+-- Since 'Int' also has a 'ToJSONKey' instance, we can similarly write:
362+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(5 :: Int, 'a')]
365+-- JSON documents only accept strings as object keys. For any type
366+-- from @base@ that has a natural textual representation, it can be
367+-- expected that its 'ToJSONKey' instance will choose that representation.
369+-- For data types that lack a natural textual representation, an alternative
370+-- is provided. The map-like container is represented as a JSON array
371+-- instead of a JSON object. Each value in the array is an array with
372+-- exactly two values. The first is the key and the second is the value.
374+-- For example, values of type '[Text]' cannot be encoded to a
375+-- string, so a 'Map' with keys of type '[Text]' is encoded as follows:
377+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(["foo","bar","baz" :: Text], 'a')]
378+-- [[["foo","bar","baz"],"a"]]
380+-- The default implementation of 'ToJSONKey' chooses this method of
381+-- encoding a key, using the 'ToJSON' instance of the type.
383+-- To use your own data type as the key in a map, all that is needed
384+-- is to write a 'ToJSONKey' (and possibly a 'FromJSONKey') instance
385+-- for it. If the type cannot be trivially converted to and from 'Text',
386+-- it is recommended that 'ToJSONKeyValue' is used. Since the default
387+-- implementations of the typeclass methods can build this from a
388+-- 'ToJSON' instance, there is nothing that needs to be written:
390+-- > data Foo = Foo { fooAge :: Int, fooName :: Text }
391+-- > deriving (Eq,Ord,Generic)
392+-- > instance ToJSON Foo
393+-- > instance ToJSONKey Foo
395+-- That's it. We can now write:
397+-- >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
398+-- >>> LBC8.putStrLn $ encode m
399+-- [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
401+-- The next case to consider is if we have a type that is a
402+-- newtype wrapper around 'Text'. The recommended approach is to use
403+-- generalized newtype deriving:
405+-- > newtype RecordId = RecordId { getRecordId :: Text }
406+-- > deriving (Eq,Ord,ToJSONKey)
408+-- Then we may write:
410+-- >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
413+-- Simple sum types are a final case worth considering. Suppose we have:
415+-- > data Color = Red | Green | Blue
416+-- > deriving (Show,Read,Eq,Ord)
418+-- It is possible to get the 'ToJSONKey' instance for free as we did
419+-- with 'Foo'. However, in this case, we have a natural way to go to
420+-- and from 'Text' that does not require any escape sequences. So
421+-- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
422+-- as objects instead of arrays of pairs. This instance may be
423+-- implemented using generics as follows:
426+-- instance 'ToJSONKey' Color where
427+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
430+-- === __Low-level implementations__
432+-- The 'Show' instance can be used to help write 'ToJSONKey':
434+-- > instance ToJSONKey Color where
435+-- > toJSONKey = ToJSONKeyText f g
436+-- > where f = Text.pack . show
437+-- > g = text . Text.pack . show
438+-- > -- text function is from Data.Aeson.Encoding
440+-- The situation of needing to turning function @a -> Text@ into
441+-- a 'ToJSONKeyFunction' is common enough that a special combinator
442+-- is provided for it. The above instance can be rewritten as:
444+-- > instance ToJSONKey Color where
445+-- > toJSONKey = toJSONKeyText (Text.pack . show)
447+-- The performance of the above instance can be improved by
448+-- not using 'String' as an intermediate step when converting to
449+-- 'Text'. One option for improving performance would be to use
450+-- template haskell machinery from the @text-show@ package. However,
451+-- even with the approach, the 'Encoding' (a wrapper around a bytestring
452+-- builder) is generated by encoding the 'Text' to a 'ByteString',
453+-- an intermediate step that could be avoided. The fastest possible
454+-- implementation would be:
456+-- > -- Assuming that OverloadedStrings is enabled
457+-- > instance ToJSONKey Color where
458+-- > toJSONKey = ToJSONKeyText f g
459+-- > where f x = case x of {Red -> "Red";Green ->"Green";Blue -> "Blue"}
460+-- > g x = case x of {Red -> text "Red";Green -> text "Green";Blue -> text "Blue"}
461+-- > -- text function is from Data.Aeson.Encoding
463+-- This works because GHC can lift the encoded values out of the case
464+-- statements, which means that they are only evaluated once. This
465+-- approach should only be used when there is a serious need to
466+-- maximize performance.
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
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
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
488+-- | Helper for creating textual keys.
491+-- instance 'ToJSONKey' MyKey where
492+-- 'toJSONKey' = 'toJSONKeyText' myKeyToText
494+-- myKeyToText = Text.pack . show -- or showt from text-show
496+toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
497+toJSONKeyText f = ToJSONKeyText f (E.text . f)
499+-- | TODO: should this be exported?
500+toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
501+toJSONKeyTextEnc e = ToJSONKeyText tot e
503+ -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
504+ tot = T.dropAround (== '"')
507+ . E.encodingToLazyByteString
510+instance Contravariant ToJSONKeyFunction where
511+ contramap = contramapToJSONKeyFunction
513+-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
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)
519+-- 'toJSONKey' for 'Generic' types.
520+-- Deriving is supported for enumeration types, i.e. the sums of nullary
521+-- constructors. The names of constructors will be used as keys for JSON
524+-- See also 'genericFromJSONKey'.
529+-- data Color = Red | Green | Blue
530+-- deriving 'Generic'
532+-- instance 'ToJSONKey' Color where
533+-- 'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
535+genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
536+ => JSONKeyOptions -> ToJSONKeyFunction a
537+genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)
539+class GetConName f => GToJSONKey f
540+instance GetConName f => GToJSONKey f
542+-------------------------------------------------------------------------------
543+-- Lifings of FromJSON and ToJSON to unary and binary type constructors
544+-------------------------------------------------------------------------------
547+-- | Lifting of the 'ToJSON' class to unary type constructors.
549+-- Instead of manually writing your 'ToJSON1' instance, there are two options
550+-- to do it automatically:
552+-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
553+-- instance at compile time. The generated instance is optimized for your type
554+-- so it will probably be more efficient than the following option.
556+-- * The compiler can provide a default generic implementation for
559+-- To use the second, simply add a @deriving 'Generic1'@ clause to your
560+-- datatype and declare a 'ToJSON1' instance for your datatype without giving
561+-- definitions for 'liftToJSON' or 'liftToEncoding'.
566+-- {-\# LANGUAGE DeriveGeneric \#-}
568+-- import "GHC.Generics"
570+-- data Pair = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
572+-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
575+-- If the default implementation doesn't give exactly the results you want,
576+-- you can customize the generic encoding with only a tiny amount of
577+-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
578+-- your preferred 'Options':
581+-- customOptions = 'defaultOptions'
582+-- { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
585+-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
586+-- 'liftToJSON' = 'genericLiftToJSON' customOptions
587+-- 'liftToEncoding' = 'genericLiftToEncoding' customOptions
590+-- See also 'ToJSON'.
591+class ToJSON1 f where
592+ liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
594+ default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
595+ => (a -> Value) -> ([a] -> Value) -> f a -> Value
596+ liftToJSON = genericLiftToJSON defaultOptions
598+ liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
599+ liftToJSONList f g = listValue (liftToJSON f g)
601+ liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
603+ default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
604+ => (a -> Encoding) -> ([a] -> Encoding)
606+ liftToEncoding = genericLiftToEncoding defaultOptions
608+ liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
609+ liftToEncodingList f g = listEncoding (liftToEncoding f g)
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 #-}
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 #-}
621+-- | Lifting of the 'ToJSON' class to binary type constructors.
623+-- Instead of manually writing your 'ToJSON2' instance, "Data.Aeson.TH"
624+-- provides Template Haskell functions which will derive an instance at compile time.
626+-- The compiler cannot provide a default generic implementation for 'liftToJSON2',
627+-- unlike 'toJSON' and 'liftToJSON'.
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)
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)
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 #-}
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 #-}
647+-------------------------------------------------------------------------------
648+-- Encoding functions
649+-------------------------------------------------------------------------------
651+-- | Helper function to use with 'liftToEncoding'.
652+-- Useful when writing own 'ToJSON1' instances.
655+-- newtype F a = F [a]
657+-- -- This instance encodes 'String' as an array of chars
658+-- instance 'ToJSON1' F where
659+-- 'liftToJSON' tj _ (F xs) = 'liftToJSON' tj ('listValue' tj) xs
660+-- 'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
662+-- instance 'Data.Aeson.FromJSON.FromJSON1' F where
663+-- 'Data.Aeson.FromJSON.liftParseJSON' p _ v = F \<$\> 'Data.Aeson.FromJSON.liftParseJSON' p ('Data.Aeson.FromJSON.listParser' p) v
665+listEncoding :: (a -> Encoding) -> [a] -> Encoding
666+listEncoding = E.list
667+{-# INLINE listEncoding #-}
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 #-}
674+-------------------------------------------------------------------------------
676+-------------------------------------------------------------------------------
678+-- These are needed for key-class default definitions
680+instance ToJSON1 [] where
681+ liftToJSON _ to' = to'
682+ {-# INLINE liftToJSON #-}
684+ liftToEncoding _ to' = to'
685+ {-# INLINE liftToEncoding #-}
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] #-}
694+ {-# INLINE toJSON #-}
696+ toEncoding = toEncoding1
697+ {-# INLINE toEncoding #-}
699+-------------------------------------------------------------------------------
700+-- Generic toJSON / toEncoding
701+-------------------------------------------------------------------------------
703+instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
704+ -- Meta-information, which is not handled elsewhere, is ignored:
705+ gToJSON opts targs = gToJSON opts targs . unM1
706+ {-# INLINE gToJSON #-}
708+instance GToJSON enc One Par1 where
709+ -- Direct occurrences of the last type parameter are encoded with the
710+ -- function passed in as an argument:
711+ gToJSON _opts (To1Args tj _) = tj . unPar1
712+ {-# INLINE gToJSON #-}
714+instance ( ConsToJSON enc arity a
715+ , AllNullary (C1 c a) allNullary
716+ , SumToJSON enc arity (C1 c a) allNullary
717+ ) => GToJSON enc arity (D1 d (C1 c a)) where
718+ -- The option 'tagSingleConstructors' determines whether to wrap
719+ -- a single-constructor type.
721+ | tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
722+ . sumToJSON opts targs
724+ | otherwise = consToJSON opts targs . unM1 . unM1
725+ {-# INLINE gToJSON #-}
727+instance (ConsToJSON enc arity a) => GToJSON enc arity (C1 c a) where
728+ -- Constructors need to be encoded differently depending on whether they're
729+ -- a record or not. This distinction is made by 'consToJSON':
730+ gToJSON opts targs = consToJSON opts targs . unM1
731+ {-# INLINE gToJSON #-}
733+instance ( AllNullary (a :+: b) allNullary
734+ , SumToJSON enc arity (a :+: b) allNullary
735+ ) => GToJSON enc arity (a :+: b)
737+ -- If all constructors of a sum datatype are nullary and the
738+ -- 'allNullaryToStringTag' option is set they are encoded to
739+ -- strings. This distinction is made by 'sumToJSON':
740+ gToJSON opts targs = (unTagged :: Tagged allNullary enc -> enc)
741+ . sumToJSON opts targs
742+ {-# INLINE gToJSON #-}
744+--------------------------------------------------------------------------------
747+-- Note: Refactoring 'ToJSON a' to 'ToJSON enc a' (and 'ToJSON1' similarly) is
748+-- possible but makes error messages a bit harder to understand for missing
751+instance GToJSON Value arity V1 where
752+ -- Empty values do not exist, which makes the job of formatting them
754+ gToJSON _ _ x = x `seq` error "case: V1"
755+ {-# INLINE gToJSON #-}
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 #-}
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 #-}
768+instance GToJSON Value arity U1 where
769+ -- Empty constructors are encoded to an empty array:
770+ gToJSON _opts _ _ = emptyArray
771+ {-# INLINE gToJSON #-}
773+instance ( WriteProduct arity a, WriteProduct arity b
774+ , ProductSize a, ProductSize b
775+ ) => GToJSON Value arity (a :*: b)
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
780+ gToJSON opts targs p =
781+ Array $ V.create $ do
782+ mv <- VM.unsafeNew lenProduct
783+ writeProduct opts targs mv 0 lenProduct p
786+ lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
788+ {-# INLINE gToJSON #-}
791+ , GToJSON Value One g
792+ ) => GToJSON Value One (f :.: g)
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 #-}
802+--------------------------------------------------------------------------------
803+-- Generic toEncoding
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 #-}
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 #-}
816+instance GToJSON Encoding arity U1 where
817+ -- Empty constructors are encoded to an empty array:
818+ gToJSON _opts _ _ = E.emptyArray_
819+ {-# INLINE gToJSON #-}
821+instance ( EncodeProduct arity a
822+ , EncodeProduct arity b
823+ ) => GToJSON Encoding arity (a :*: b)
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
828+ gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
829+ {-# INLINE gToJSON #-}
832+ , GToJSON Encoding One g
833+ ) => GToJSON Encoding One (f :.: g)
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 #-}
843+--------------------------------------------------------------------------------
845+class SumToJSON enc arity f allNullary where
846+ sumToJSON :: Options -> ToArgs enc arity a
847+ -> f a -> Tagged allNullary enc
849+instance ( GetConName f
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
857+ sumToJSON opts targs
858+ | allNullaryToStringTag opts = Tagged . fromString
859+ . constructorTagModifier opts . getConName
860+ | otherwise = Tagged . nonAllNullarySumToJSON opts targs
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
868+ sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
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
876+nonAllNullarySumToJSON opts targs =
877+ case sumEncoding opts of
880+ taggedObject opts targs tagFieldName contentsFieldName
882+ ObjectWithSingleField ->
883+ (unTagged :: Tagged ObjectWithSingleField enc -> enc)
884+ . sumToJSON' opts targs
887+ (unTagged :: Tagged TwoElemArray enc -> enc)
888+ . sumToJSON' opts targs
891+ (unTagged :: Tagged UntaggedValue enc -> enc)
892+ . sumToJSON' opts targs
894+--------------------------------------------------------------------------------
896+class FromString enc where
897+ fromString :: String -> enc
899+instance FromString Encoding where
900+ fromString = toEncoding
902+instance FromString Value where
903+ fromString = String . pack
905+--------------------------------------------------------------------------------
907+class TaggedObject enc arity f where
908+ taggedObject :: Options -> ToArgs enc arity a
912+instance ( TaggedObject enc arity a
913+ , TaggedObject enc arity b
914+ ) => TaggedObject enc arity (a :+: b)
916+ taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
917+ taggedObject opts targs tagFieldName contentsFieldName x
918+ taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
919+ taggedObject opts targs tagFieldName contentsFieldName x
921+instance ( IsRecord a isRecord
922+ , TaggedObject' enc pairs arity a isRecord
923+ , FromPairs enc pairs
925+ , KeyValuePair enc pairs
927+ ) => TaggedObject enc arity (C1 c a)
929+ taggedObject opts targs tagFieldName contentsFieldName =
930+ fromPairs . mappend tag . contents
932+ tag = tagFieldName `pair`
933+ (fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
936+ (unTagged :: Tagged isRecord pairs -> pairs) .
937+ taggedObject' opts targs contentsFieldName . unM1
939+class TaggedObject' enc pairs arity f isRecord where
940+ taggedObject' :: Options -> ToArgs enc arity a
941+ -> String -> f a -> Tagged isRecord pairs
943+instance ( GToJSON enc arity f
944+ , KeyValuePair enc pairs
945+ ) => TaggedObject' enc pairs arity f False
947+ taggedObject' opts targs contentsFieldName =
948+ Tagged . (contentsFieldName `pair`) . gToJSON opts targs
950+instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
951+ taggedObject' _ _ _ _ = Tagged mempty
953+instance ( RecordToPairs enc pairs arity f
954+ ) => TaggedObject' enc pairs arity f True
956+ taggedObject' opts targs _ = Tagged . recordToPairs opts targs
958+--------------------------------------------------------------------------------
960+-- | Get the name of the constructor of a sum datatype.
961+class GetConName f where
962+ getConName :: f a -> String
964+instance (GetConName a, GetConName b) => GetConName (a :+: b) where
965+ getConName (L1 x) = getConName x
966+ getConName (R1 x) = getConName x
968+instance (Constructor c) => GetConName (C1 c a) where
969+ getConName = conName
971+-- For genericToJSONKey
972+instance GetConName a => GetConName (D1 d a) where
973+ getConName (M1 x) = getConName x
975+--------------------------------------------------------------------------------
977+-- Reflection of SumEncoding variants
979+data ObjectWithSingleField
983+--------------------------------------------------------------------------------
985+class SumToJSON' s enc arity f where
986+ sumToJSON' :: Options -> ToArgs enc arity a
987+ -> f a -> Tagged s enc
989+instance ( SumToJSON' s enc arity a
990+ , SumToJSON' s enc arity b
991+ ) => SumToJSON' s enc arity (a :+: b)
993+ sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
994+ sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
996+--------------------------------------------------------------------------------
998+instance ( GToJSON Value arity a
999+ , ConsToJSON Value arity a
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
1009+--------------------------------------------------------------------------------
1011+instance ( GToJSON Encoding arity a
1012+ , ConsToJSON Encoding arity a
1014+ ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
1016+ sumToJSON' opts targs x = Tagged $ E.list id
1017+ [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
1018+ , gToJSON opts targs x
1021+--------------------------------------------------------------------------------
1023+class ConsToJSON enc arity f where
1024+ consToJSON :: Options -> ToArgs enc arity a
1027+class ConsToJSON' enc arity f isRecord where
1028+ consToJSON' :: Options -> ToArgs enc arity a
1029+ -> f a -> Tagged isRecord enc
1031+instance ( IsRecord f isRecord
1032+ , ConsToJSON' enc arity f isRecord
1033+ ) => ConsToJSON enc arity f
1035+ consToJSON opts targs =
1036+ (unTagged :: Tagged isRecord enc -> enc)
1037+ . consToJSON' opts targs
1038+ {-# INLINE consToJSON #-}
1040+instance OVERLAPPING_
1041+ ( RecordToPairs enc pairs arity (S1 s f)
1042+ , FromPairs enc pairs
1043+ , GToJSON enc arity f
1044+ ) => ConsToJSON' enc arity (S1 s f) True
1046+ consToJSON' opts targs
1047+ | unwrapUnaryRecords opts = Tagged . gToJSON opts targs
1048+ | otherwise = Tagged . fromPairs . recordToPairs opts targs
1049+ {-# INLINE consToJSON' #-}
1051+instance ( RecordToPairs enc pairs arity f
1052+ , FromPairs enc pairs
1053+ ) => ConsToJSON' enc arity f True
1055+ consToJSON' opts targs = Tagged . fromPairs . recordToPairs opts targs
1056+ {-# INLINE consToJSON' #-}
1058+instance GToJSON enc arity f => ConsToJSON' enc arity f False where
1059+ consToJSON' opts targs = Tagged . gToJSON opts targs
1060+ {-# INLINE consToJSON' #-}
1062+--------------------------------------------------------------------------------
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
1071+instance ( Monoid pairs
1072+ , RecordToPairs enc pairs arity a
1073+ , RecordToPairs enc pairs arity b
1074+ ) => RecordToPairs enc pairs arity (a :*: b)
1076+ recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
1077+ pairsOf a `mappend` pairsOf b
1079+ pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
1080+ pairsOf = recordToPairs opts targs
1081+ {-# INLINE recordToPairs #-}
1083+instance ( Selector s
1084+ , GToJSON enc arity a
1085+ , KeyValuePair enc pairs
1086+ ) => RecordToPairs enc pairs arity (S1 s a)
1088+ recordToPairs = fieldToPair
1089+ {-# INLINE recordToPairs #-}
1091+instance INCOHERENT_
1093+ , GToJSON enc arity (K1 i (Maybe a))
1094+ , KeyValuePair enc pairs
1096+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
1098+ recordToPairs opts _ (M1 k1) | omitNothingFields opts
1099+ , K1 Nothing <- k1 = mempty
1100+ recordToPairs opts targs m1 = fieldToPair opts targs m1
1101+ {-# INLINE recordToPairs #-}
1103+instance INCOHERENT_
1105+ , GToJSON enc arity (K1 i (Maybe a))
1106+ , KeyValuePair enc pairs
1108+ ) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
1110+ recordToPairs opts targs = recordToPairs opts targs . unwrap
1112+ unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
1113+ unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
1114+ {-# INLINE recordToPairs #-}
1116+fieldToPair :: (Selector s
1117+ , GToJSON enc arity a
1118+ , KeyValuePair enc pairs)
1119+ => Options -> ToArgs enc arity p
1120+ -> S1 s a p -> pairs
1121+fieldToPair opts targs m1 =
1122+ let key = fieldLabelModifier opts (selName m1)
1123+ value = gToJSON opts targs (unM1 m1)
1124+ in key `pair` value
1125+{-# INLINE fieldToPair #-}
1127+--------------------------------------------------------------------------------
1129+class WriteProduct arity f where
1130+ writeProduct :: Options
1131+ -> ToArgs Value arity a
1132+ -> VM.MVector s Value
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
1145+ lenL = len `unsafeShiftR` 1
1148+ {-# INLINE writeProduct #-}
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 #-}
1155+--------------------------------------------------------------------------------
1157+class EncodeProduct arity f where
1158+ encodeProduct :: Options -> ToArgs Encoding arity a
1159+ -> f a -> Encoding' E.InArray
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 #-}
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 #-}
1177+--------------------------------------------------------------------------------
1179+instance ( GToJSON enc arity a
1180+ , ConsToJSON enc arity a
1181+ , FromPairs enc pairs
1182+ , KeyValuePair enc pairs
1184+ ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
1186+ sumToJSON' opts targs =
1187+ Tagged . fromPairs . (typ `pair`) . gToJSON opts targs
1189+ typ = constructorTagModifier opts $
1190+ conName (undefined :: t c a p)
1192+--------------------------------------------------------------------------------
1194+instance OVERLAPPABLE_
1195+ ( ConsToJSON enc arity a
1196+ ) => SumToJSON' UntaggedValue enc arity (C1 c a)
1198+ sumToJSON' opts targs = Tagged . gToJSON opts targs
1200+instance OVERLAPPING_
1203+ ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
1205+ sumToJSON' opts _ _ = Tagged . fromString $
1206+ constructorTagModifier opts $ conName (undefined :: t c U1 p)
1208+-------------------------------------------------------------------------------
1210+-------------------------------------------------------------------------------
1212+-------------------------------------------------------------------------------
1214+-------------------------------------------------------------------------------
1216+instance ToJSON2 Const where
1217+ liftToJSON2 t _ _ _ (Const x) = t x
1218+ {-# INLINE liftToJSON2 #-}
1220+ liftToEncoding2 t _ _ _ (Const x) = t x
1221+ {-# INLINE liftToEncoding2 #-}
1223+instance ToJSON a => ToJSON1 (Const a) where
1224+ liftToJSON _ _ (Const x) = toJSON x
1225+ {-# INLINE liftToJSON #-}
1227+ liftToEncoding _ _ (Const x) = toEncoding x
1228+ {-# INLINE liftToEncoding #-}
1230+instance ToJSON a => ToJSON (Const a b) where
1231+ toJSON (Const x) = toJSON x
1232+ {-# INLINE toJSON #-}
1234+ toEncoding (Const x) = toEncoding x
1235+ {-# INLINE toEncoding #-}
1238+instance ToJSON1 Maybe where
1239+ liftToJSON t _ (Just a) = t a
1240+ liftToJSON _ _ Nothing = Null
1241+ {-# INLINE liftToJSON #-}
1243+ liftToEncoding t _ (Just a) = t a
1244+ liftToEncoding _ _ Nothing = E.null_
1245+ {-# INLINE liftToEncoding #-}
1247+instance (ToJSON a) => ToJSON (Maybe a) where
1249+ {-# INLINE toJSON #-}
1251+ toEncoding = toEncoding1
1252+ {-# INLINE toEncoding #-}
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 #-}
1260+ liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
1262+ liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b
1263+ {-# INLINE liftToEncoding2 #-}
1265+instance (ToJSON a) => ToJSON1 (Either a) where
1266+ liftToJSON = liftToJSON2 toJSON toJSONList
1267+ {-# INLINE liftToJSON #-}
1269+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
1270+ {-# INLINE liftToEncoding #-}
1272+instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
1274+ {-# INLINE toJSON #-}
1276+ toEncoding = toEncoding2
1277+ {-# INLINE toEncoding #-}
1279+instance ToJSON Void where
1281+ {-# INLINE toJSON #-}
1283+ toEncoding = absurd
1284+ {-# INLINE toEncoding #-}
1287+instance ToJSON Bool where
1289+ {-# INLINE toJSON #-}
1291+ toEncoding = E.bool
1292+ {-# INLINE toEncoding #-}
1294+instance ToJSONKey Bool where
1295+ toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
1298+instance ToJSON Ordering where
1299+ toJSON = toJSON . orderingToText
1300+ toEncoding = toEncoding . orderingToText
1302+orderingToText :: Ordering -> T.Text
1303+orderingToText o = case o of
1308+instance ToJSON () where
1309+ toJSON _ = emptyArray
1310+ {-# INLINE toJSON #-}
1312+ toEncoding _ = emptyArray_
1313+ {-# INLINE toEncoding #-}
1316+instance ToJSON Char where
1317+ toJSON = String . T.singleton
1318+ {-# INLINE toJSON #-}
1320+ toJSONList = String . T.pack
1321+ {-# INLINE toJSONList #-}
1323+ toEncoding = E.string . (:[])
1324+ {-# INLINE toEncoding #-}
1326+ toEncodingList = E.string
1327+ {-# INLINE toEncodingList #-}
1330+instance ToJSON Double where
1331+ toJSON = realFloatToJSON
1332+ {-# INLINE toJSON #-}
1334+ toEncoding = E.double
1335+ {-# INLINE toEncoding #-}
1337+instance ToJSONKey Double where
1338+ toJSONKey = toJSONKeyTextEnc E.doubleText
1339+ {-# INLINE toJSONKey #-}
1342+instance ToJSON Number where
1343+ toJSON (D d) = toJSON d
1344+ toJSON (I i) = toJSON i
1345+ {-# INLINE toJSON #-}
1347+ toEncoding (D d) = toEncoding d
1348+ toEncoding (I i) = toEncoding i
1349+ {-# INLINE toEncoding #-}
1352+instance ToJSON Float where
1353+ toJSON = realFloatToJSON
1354+ {-# INLINE toJSON #-}
1356+ toEncoding = E.float
1357+ {-# INLINE toEncoding #-}
1359+instance ToJSONKey Float where
1360+ toJSONKey = toJSONKeyTextEnc E.floatText
1361+ {-# INLINE toJSONKey #-}
1364+instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
1365+ toJSON r = object [ "numerator" .= numerator r
1366+ , "denominator" .= denominator r
1368+ {-# INLINE toJSON #-}
1370+ toEncoding r = E.pairs $
1371+ "numerator" .= numerator r <>
1372+ "denominator" .= denominator r
1373+ {-# INLINE toEncoding #-}
1376+instance HasResolution a => ToJSON (Fixed a) where
1377+ toJSON = Number . realToFrac
1378+ {-# INLINE toJSON #-}
1380+ toEncoding = E.scientific . realToFrac
1381+ {-# INLINE toEncoding #-}
1383+instance HasResolution a => ToJSONKey (Fixed a) where
1384+ toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)
1385+ {-# INLINE toJSONKey #-}
1388+instance ToJSON Int where
1389+ toJSON = Number . fromIntegral
1390+ {-# INLINE toJSON #-}
1393+ {-# INLINE toEncoding #-}
1395+instance ToJSONKey Int where
1396+ toJSONKey = toJSONKeyTextEnc E.intText
1397+ {-# INLINE toJSONKey #-}
1400+instance ToJSON Integer where
1401+ toJSON = Number . fromInteger
1402+ {-# INLINE toJSON #-}
1404+ toEncoding = E.integer
1405+ {-# INLINE toEncoding #-}
1407+instance ToJSONKey Integer where
1408+ toJSONKey = toJSONKeyTextEnc E.integerText
1409+ {-# INLINE toJSONKey #-}
1412+instance ToJSON Natural where
1413+ toJSON = toJSON . toInteger
1414+ {-# INLINE toJSON #-}
1416+ toEncoding = toEncoding . toInteger
1417+ {-# INLINE toEncoding #-}
1419+instance ToJSONKey Natural where
1420+ toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)
1421+ {-# INLINE toJSONKey #-}
1424+instance ToJSON Int8 where
1425+ toJSON = Number . fromIntegral
1426+ {-# INLINE toJSON #-}
1428+ toEncoding = E.int8
1429+ {-# INLINE toEncoding #-}
1431+instance ToJSONKey Int8 where
1432+ toJSONKey = toJSONKeyTextEnc E.int8Text
1433+ {-# INLINE toJSONKey #-}
1436+instance ToJSON Int16 where
1437+ toJSON = Number . fromIntegral
1438+ {-# INLINE toJSON #-}
1440+ toEncoding = E.int16
1441+ {-# INLINE toEncoding #-}
1443+instance ToJSONKey Int16 where
1444+ toJSONKey = toJSONKeyTextEnc E.int16Text
1445+ {-# INLINE toJSONKey #-}
1448+instance ToJSON Int32 where
1449+ toJSON = Number . fromIntegral
1450+ {-# INLINE toJSON #-}
1452+ toEncoding = E.int32
1453+ {-# INLINE toEncoding #-}
1455+instance ToJSONKey Int32 where
1456+ toJSONKey = toJSONKeyTextEnc E.int32Text
1457+ {-# INLINE toJSONKey #-}
1460+instance ToJSON Int64 where
1461+ toJSON = Number . fromIntegral
1462+ {-# INLINE toJSON #-}
1464+ toEncoding = E.int64
1465+ {-# INLINE toEncoding #-}
1467+instance ToJSONKey Int64 where
1468+ toJSONKey = toJSONKeyTextEnc E.int64Text
1469+ {-# INLINE toJSONKey #-}
1471+instance ToJSON Word where
1472+ toJSON = Number . fromIntegral
1473+ {-# INLINE toJSON #-}
1475+ toEncoding = E.word
1476+ {-# INLINE toEncoding #-}
1478+instance ToJSONKey Word where
1479+ toJSONKey = toJSONKeyTextEnc E.wordText
1480+ {-# INLINE toJSONKey #-}
1483+instance ToJSON Word8 where
1484+ toJSON = Number . fromIntegral
1485+ {-# INLINE toJSON #-}
1487+ toEncoding = E.word8
1488+ {-# INLINE toEncoding #-}
1490+instance ToJSONKey Word8 where
1491+ toJSONKey = toJSONKeyTextEnc E.word8Text
1492+ {-# INLINE toJSONKey #-}
1495+instance ToJSON Word16 where
1496+ toJSON = Number . fromIntegral
1497+ {-# INLINE toJSON #-}
1499+ toEncoding = E.word16
1500+ {-# INLINE toEncoding #-}
1502+instance ToJSONKey Word16 where
1503+ toJSONKey = toJSONKeyTextEnc E.word16Text
1504+ {-# INLINE toJSONKey #-}
1507+instance ToJSON Word32 where
1508+ toJSON = Number . fromIntegral
1509+ {-# INLINE toJSON #-}
1511+ toEncoding = E.word32
1512+ {-# INLINE toEncoding #-}
1514+instance ToJSONKey Word32 where
1515+ toJSONKey = toJSONKeyTextEnc E.word32Text
1516+ {-# INLINE toJSONKey #-}
1519+instance ToJSON Word64 where
1520+ toJSON = Number . fromIntegral
1521+ {-# INLINE toJSON #-}
1523+ toEncoding = E.word64
1524+ {-# INLINE toEncoding #-}
1526+instance ToJSONKey Word64 where
1527+ toJSONKey = toJSONKeyTextEnc E.word64Text
1528+ {-# INLINE toJSONKey #-}
1530+instance ToJSON CTime where
1531+ toJSON (CTime i) = toJSON i
1532+ {-# INLINE toJSON #-}
1534+ toEncoding (CTime i) = toEncoding i
1535+ {-# INLINE toEncoding #-}
1537+instance ToJSON Text where
1539+ {-# INLINE toJSON #-}
1541+ toEncoding = E.text
1542+ {-# INLINE toEncoding #-}
1544+instance ToJSONKey Text where
1545+ toJSONKey = toJSONKeyText id
1546+ {-# INLINE toJSONKey #-}
1549+instance ToJSON LT.Text where
1550+ toJSON = String . LT.toStrict
1551+ {-# INLINE toJSON #-}
1553+ toEncoding = E.lazyText
1554+ {-# INLINE toEncoding #-}
1556+instance ToJSONKey LT.Text where
1557+ toJSONKey = toJSONKeyText LT.toStrict
1560+instance ToJSON Version where
1561+ toJSON = toJSON . showVersion
1562+ {-# INLINE toJSON #-}
1564+ toEncoding = toEncoding . showVersion
1565+ {-# INLINE toEncoding #-}
1567+instance ToJSONKey Version where
1568+ toJSONKey = toJSONKeyText (T.pack . showVersion)
1570+-------------------------------------------------------------------------------
1571+-- semigroups NonEmpty
1572+-------------------------------------------------------------------------------
1574+instance ToJSON1 NonEmpty where
1575+ liftToJSON t _ = listValue t . NE.toList
1576+ {-# INLINE liftToJSON #-}
1578+ liftToEncoding t _ = listEncoding t . NE.toList
1579+ {-# INLINE liftToEncoding #-}
1581+instance (ToJSON a) => ToJSON (NonEmpty a) where
1583+ {-# INLINE toJSON #-}
1585+ toEncoding = toEncoding1
1586+ {-# INLINE toEncoding #-}
1588+-------------------------------------------------------------------------------
1590+-------------------------------------------------------------------------------
1592+instance ToJSON Scientific where
1594+ {-# INLINE toJSON #-}
1596+ toEncoding = E.scientific
1597+ {-# INLINE toEncoding #-}
1599+instance ToJSONKey Scientific where
1600+ toJSONKey = toJSONKeyTextEnc E.scientificText
1602+-------------------------------------------------------------------------------
1604+-------------------------------------------------------------------------------
1606+instance ToJSON1 DList.DList where
1607+ liftToJSON t _ = listValue t . toList
1608+ {-# INLINE liftToJSON #-}
1610+ liftToEncoding t _ = listEncoding t . toList
1611+ {-# INLINE liftToEncoding #-}
1613+instance (ToJSON a) => ToJSON (DList.DList a) where
1615+ {-# INLINE toJSON #-}
1617+ toEncoding = toEncoding1
1618+ {-# INLINE toEncoding #-}
1620+-------------------------------------------------------------------------------
1621+-- transformers - Functors
1622+-------------------------------------------------------------------------------
1624+instance ToJSON1 Identity where
1625+ liftToJSON t _ (Identity a) = t a
1626+ {-# INLINE liftToJSON #-}
1628+ liftToJSONList _ tl xs = tl (map runIdentity xs)
1629+ {-# INLINE liftToJSONList #-}
1631+ liftToEncoding t _ (Identity a) = t a
1632+ {-# INLINE liftToEncoding #-}
1634+ liftToEncodingList _ tl xs = tl (map runIdentity xs)
1635+ {-# INLINE liftToEncodingList #-}
1637+instance (ToJSON a) => ToJSON (Identity a) where
1639+ {-# INLINE toJSON #-}
1641+ toJSONList = liftToJSONList toJSON toJSONList
1642+ {-# INLINE toJSONList #-}
1644+ toEncoding = toEncoding1
1645+ {-# INLINE toEncoding #-}
1647+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1648+ {-# INLINE toEncodingList #-}
1650+instance (ToJSONKey a) => ToJSONKey (Identity a) where
1651+ toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
1652+ toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
1655+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
1656+ liftToJSON tv tvl (Compose x) = liftToJSON g gl x
1658+ g = liftToJSON tv tvl
1659+ gl = liftToJSONList tv tvl
1660+ {-# INLINE liftToJSON #-}
1662+ liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
1664+ g = liftToJSON te tel
1665+ gl = liftToJSONList te tel
1666+ {-# INLINE liftToJSONList #-}
1668+ liftToEncoding te tel (Compose x) = liftToEncoding g gl x
1670+ g = liftToEncoding te tel
1671+ gl = liftToEncodingList te tel
1672+ {-# INLINE liftToEncoding #-}
1674+ liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
1676+ g = liftToEncoding te tel
1677+ gl = liftToEncodingList te tel
1678+ {-# INLINE liftToEncodingList #-}
1680+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
1682+ {-# INLINE toJSON #-}
1684+ toJSONList = liftToJSONList toJSON toJSONList
1685+ {-# INLINE toJSONList #-}
1687+ toEncoding = toEncoding1
1688+ {-# INLINE toEncoding #-}
1690+ toEncodingList = liftToEncodingList toEncoding toEncodingList
1691+ {-# INLINE toEncodingList #-}
1694+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where
1695+ liftToJSON tv tvl (Pair x y) = liftToJSON2 tx txl ty tyl (x, y)
1697+ tx = liftToJSON tv tvl
1698+ txl = liftToJSONList tv tvl
1699+ ty = liftToJSON tv tvl
1700+ tyl = liftToJSONList tv tvl
1702+ liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
1704+ tx = liftToEncoding te tel
1705+ txl = liftToEncodingList te tel
1706+ ty = liftToEncoding te tel
1707+ tyl = liftToEncodingList te tel
1709+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
1711+ {-# INLINE toJSON #-}
1713+ toEncoding = toEncoding1
1714+ {-# INLINE toEncoding #-}
1716+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where
1717+ liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)
1718+ liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)
1720+ liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x
1721+ liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y
1723+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
1725+ {-# INLINE toJSON #-}
1727+ toEncoding = toEncoding1
1728+ {-# INLINE toEncoding #-}
1730+-------------------------------------------------------------------------------
1732+-------------------------------------------------------------------------------
1734+instance ToJSON1 Seq.Seq where
1735+ liftToJSON t _ = listValue t . toList
1736+ {-# INLINE liftToJSON #-}
1738+ liftToEncoding t _ = listEncoding t . toList
1739+ {-# INLINE liftToEncoding #-}
1741+instance (ToJSON a) => ToJSON (Seq.Seq a) where
1743+ {-# INLINE toJSON #-}
1745+ toEncoding = toEncoding1
1746+ {-# INLINE toEncoding #-}
1749+instance ToJSON1 Set.Set where
1750+ liftToJSON t _ = listValue t . Set.toList
1751+ {-# INLINE liftToJSON #-}
1753+ liftToEncoding t _ = listEncoding t . Set.toList
1754+ {-# INLINE liftToEncoding #-}
1756+instance (ToJSON a) => ToJSON (Set.Set a) where
1758+ {-# INLINE toJSON #-}
1760+ toEncoding = toEncoding1
1761+ {-# INLINE toEncoding #-}
1764+instance ToJSON IntSet.IntSet where
1765+ toJSON = toJSON . IntSet.toList
1766+ {-# INLINE toJSON #-}
1768+ toEncoding = toEncoding . IntSet.toList
1769+ {-# INLINE toEncoding #-}
1772+instance ToJSON1 IntMap.IntMap where
1773+ liftToJSON t tol = liftToJSON to' tol' . IntMap.toList
1775+ to' = liftToJSON2 toJSON toJSONList t tol
1776+ tol' = liftToJSONList2 toJSON toJSONList t tol
1777+ {-# INLINE liftToJSON #-}
1779+ liftToEncoding t tol = liftToEncoding to' tol' . IntMap.toList
1781+ to' = liftToEncoding2 toEncoding toEncodingList t tol
1782+ tol' = liftToEncodingList2 toEncoding toEncodingList t tol
1783+ {-# INLINE liftToEncoding #-}
1785+instance ToJSON a => ToJSON (IntMap.IntMap a) where
1787+ {-# INLINE toJSON #-}
1789+ toEncoding = toEncoding1
1790+ {-# INLINE toEncoding #-}
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 #-}
1799+ liftToEncoding g _ = case toJSONKey of
1800+ ToJSONKeyText _ f -> dict f g M.foldrWithKey
1801+ ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
1803+ pairEncoding f (a, b) = E.list id [f a, g b]
1804+ {-# INLINE liftToEncoding #-}
1807+instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
1809+ {-# INLINE toJSON #-}
1811+ toEncoding = toEncoding1
1812+ {-# INLINE toEncoding #-}
1815+instance ToJSON1 Tree.Tree where
1816+ liftToJSON t tol = go
1818+ go (Tree.Node root branches) =
1819+ liftToJSON2 t tol to' tol' (root, branches)
1821+ to' = liftToJSON go (listValue go)
1822+ tol' = liftToJSONList go (listValue go)
1823+ {-# INLINE liftToJSON #-}
1825+ liftToEncoding t tol = go
1827+ go (Tree.Node root branches) =
1828+ liftToEncoding2 t tol to' tol' (root, branches)
1830+ to' = liftToEncoding go (listEncoding go)
1831+ tol' = liftToEncodingList go (listEncoding go)
1832+ {-# INLINE liftToEncoding #-}
1834+instance (ToJSON v) => ToJSON (Tree.Tree v) where
1836+ {-# INLINE toJSON #-}
1838+ toEncoding = toEncoding1
1839+ {-# INLINE toEncoding #-}
1841+-------------------------------------------------------------------------------
1843+-------------------------------------------------------------------------------
1845+instance ToJSON UUID.UUID where
1846+ toJSON = toJSON . UUID.toText
1847+ toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1849+instance ToJSONKey UUID.UUID where
1850+ toJSONKey = ToJSONKeyText UUID.toText $
1851+ E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
1853+-------------------------------------------------------------------------------
1855+-------------------------------------------------------------------------------
1857+instance ToJSON1 Vector where
1858+ liftToJSON t _ = Array . V.map t
1859+ {-# INLINE liftToJSON #-}
1861+ liftToEncoding t _ = listEncoding t . V.toList
1862+ {-# INLINE liftToEncoding #-}
1864+instance (ToJSON a) => ToJSON (Vector a) where
1865+ {-# SPECIALIZE instance ToJSON Array #-}
1868+ {-# INLINE toJSON #-}
1870+ toEncoding = toEncoding1
1871+ {-# INLINE toEncoding #-}
1873+encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
1874+encodeVector = listEncoding toEncoding . VG.toList
1875+{-# INLINE encodeVector #-}
1877+vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
1878+vectorToJSON = Array . V.map toJSON . V.convert
1879+{-# INLINE vectorToJSON #-}
1881+instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
1882+ toJSON = vectorToJSON
1883+ {-# INLINE toJSON #-}
1885+ toEncoding = encodeVector
1886+ {-# INLINE toEncoding #-}
1889+instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
1890+ toJSON = vectorToJSON
1891+ {-# INLINE toJSON #-}
1893+ toEncoding = encodeVector
1894+ {-# INLINE toEncoding #-}
1897+instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
1898+ toJSON = vectorToJSON
1899+ {-# INLINE toJSON #-}
1901+ toEncoding = encodeVector
1902+ {-# INLINE toEncoding #-}
1904+-------------------------------------------------------------------------------
1905+-- unordered-containers
1906+-------------------------------------------------------------------------------
1908+instance ToJSON1 HashSet.HashSet where
1909+ liftToJSON t _ = listValue t . HashSet.toList
1910+ {-# INLINE liftToJSON #-}
1912+ liftToEncoding t _ = listEncoding t . HashSet.toList
1913+ {-# INLINE liftToEncoding #-}
1915+instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
1917+ {-# INLINE toJSON #-}
1919+ toEncoding = toEncoding1
1920+ {-# INLINE toEncoding #-}
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 #-}
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
1934+ pairEncoding f (a, b) = E.list id [f a, g b]
1935+ {-# INLINE liftToEncoding #-}
1937+instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
1938+ {-# SPECIALIZE instance ToJSON Object #-}
1941+ {-# INLINE toJSON #-}
1943+ toEncoding = toEncoding1
1944+ {-# INLINE toEncoding #-}
1946+-------------------------------------------------------------------------------
1948+-------------------------------------------------------------------------------
1950+instance ToJSON Value where
1952+ {-# INLINE toJSON #-}
1954+ toEncoding = E.value
1955+ {-# INLINE toEncoding #-}
1957+instance ToJSON DotNetTime where
1958+ toJSON = toJSON . dotNetTime
1960+ toEncoding = toEncoding . dotNetTime
1962+dotNetTime :: DotNetTime -> String
1963+dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
1964+ where secs = formatTime defaultTimeLocale "/Date(%s" t
1966+formatMillis :: (FormatTime t) => t -> String
1967+formatMillis = take 3 . formatTime defaultTimeLocale "%q"
1969+-------------------------------------------------------------------------------
1971+-------------------------------------------------------------------------------
1973+instance ToJSON a => ToJSON (PM.Array a) where
1974+ -- note: we could do better than this if vector exposed the data
1975+ -- constructor in Data.Vector.
1976+ toJSON = toJSON . Exts.toList
1977+ toEncoding = toEncoding . Exts.toList
1979+instance ToJSON a => ToJSON (PM.SmallArray a) where
1980+ toJSON = toJSON . Exts.toList
1981+ toEncoding = toEncoding . Exts.toList
1983+#if (MIN_VERSION_primitive(0,6,4))
1984+instance (PM.Prim a,ToJSON a) => ToJSON (PM.PrimArray a) where
1985+ toJSON = toJSON . Exts.toList
1986+ toEncoding = toEncoding . Exts.toList
1988+#if !MIN_VERSION_primitive(0,7,0)
1989+instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where
1990+ toJSON = toJSON . Exts.toList
1991+ toEncoding = toEncoding . Exts.toList
1995+-------------------------------------------------------------------------------
1997+-------------------------------------------------------------------------------
1999+instance ToJSON Day where
2000+ toJSON = stringEncoding . E.day
2003+instance ToJSONKey Day where
2004+ toJSONKey = toJSONKeyTextEnc E.day
2007+instance ToJSON TimeOfDay where
2008+ toJSON = stringEncoding . E.timeOfDay
2009+ toEncoding = E.timeOfDay
2011+instance ToJSONKey TimeOfDay where
2012+ toJSONKey = toJSONKeyTextEnc E.timeOfDay
2015+instance ToJSON LocalTime where
2016+ toJSON = stringEncoding . E.localTime
2017+ toEncoding = E.localTime
2019+instance ToJSONKey LocalTime where
2020+ toJSONKey = toJSONKeyTextEnc E.localTime
2023+instance ToJSON ZonedTime where
2024+ toJSON = stringEncoding . E.zonedTime
2025+ toEncoding = E.zonedTime
2027+instance ToJSONKey ZonedTime where
2028+ toJSONKey = toJSONKeyTextEnc E.zonedTime
2031+instance ToJSON UTCTime where
2032+ toJSON = stringEncoding . E.utcTime
2033+ toEncoding = E.utcTime
2035+instance ToJSONKey UTCTime where
2036+ toJSONKey = toJSONKeyTextEnc E.utcTime
2038+-- | Encode something t a JSON string.
2039+stringEncoding :: Encoding' Text -> Value
2040+stringEncoding = String
2041+ . T.dropAround (== '"')
2044+ . E.encodingToLazyByteString
2045+{-# INLINE stringEncoding #-}
2048+instance ToJSON NominalDiffTime where
2049+ toJSON = Number . realToFrac
2050+ {-# INLINE toJSON #-}
2052+ toEncoding = E.scientific . realToFrac
2053+ {-# INLINE toEncoding #-}
2056+instance ToJSON DiffTime where
2057+ toJSON = Number . realToFrac
2058+ {-# INLINE toJSON #-}
2060+ toEncoding = E.scientific . realToFrac
2061+ {-# INLINE toEncoding #-}
2063+-- | Encoded as number
2064+instance ToJSON SystemTime where
2065+ toJSON (MkSystemTime secs nsecs) =
2066+ toJSON (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2067+ toEncoding (MkSystemTime secs nsecs) =
2068+ toEncoding (fromIntegral secs + fromIntegral nsecs / 1000000000 :: Nano)
2070+instance ToJSON CalendarDiffTime where
2071+ toJSON (CalendarDiffTime m nt) = object
2075+ toEncoding (CalendarDiffTime m nt) = E.pairs
2076+ ("months" .= m <> "time" .= nt)
2078+instance ToJSON CalendarDiffDays where
2079+ toJSON (CalendarDiffDays m d) = object
2083+ toEncoding (CalendarDiffDays m d) = E.pairs
2084+ ("months" .= m <> "days" .= d)
2086+instance ToJSON DayOfWeek where
2087+ toJSON Monday = "monday"
2088+ toJSON Tuesday = "tuesday"
2089+ toJSON Wednesday = "wednesday"
2090+ toJSON Thursday = "thursday"
2091+ toJSON Friday = "friday"
2092+ toJSON Saturday = "saturday"
2093+ toJSON Sunday = "sunday"
2095+toEncodingDayOfWeek :: DayOfWeek -> E.Encoding' Text
2096+toEncodingDayOfWeek Monday = E.unsafeToEncoding "\"monday\""
2097+toEncodingDayOfWeek Tuesday = E.unsafeToEncoding "\"tuesday\""
2098+toEncodingDayOfWeek Wednesday = E.unsafeToEncoding "\"wednesday\""
2099+toEncodingDayOfWeek Thursday = E.unsafeToEncoding "\"thursday\""
2100+toEncodingDayOfWeek Friday = E.unsafeToEncoding "\"friday\""
2101+toEncodingDayOfWeek Saturday = E.unsafeToEncoding "\"saturday\""
2102+toEncodingDayOfWeek Sunday = E.unsafeToEncoding "\"sunday\""
2104+instance ToJSONKey DayOfWeek where
2105+ toJSONKey = toJSONKeyTextEnc toEncodingDayOfWeek
2107+-------------------------------------------------------------------------------
2108+-- base Monoid/Semigroup
2109+-------------------------------------------------------------------------------
2111+instance ToJSON1 Monoid.Dual where
2112+ liftToJSON t _ = t . Monoid.getDual
2113+ {-# INLINE liftToJSON #-}
2115+ liftToEncoding t _ = t . Monoid.getDual
2116+ {-# INLINE liftToEncoding #-}
2118+instance ToJSON a => ToJSON (Monoid.Dual a) where
2120+ {-# INLINE toJSON #-}
2122+ toEncoding = toEncoding1
2123+ {-# INLINE toEncoding #-}
2126+instance ToJSON1 Monoid.First where
2127+ liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
2128+ {-# INLINE liftToJSON #-}
2130+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
2131+ {-# INLINE liftToEncoding #-}
2133+instance ToJSON a => ToJSON (Monoid.First a) where
2135+ {-# INLINE toJSON #-}
2137+ toEncoding = toEncoding1
2138+ {-# INLINE toEncoding #-}
2141+instance ToJSON1 Monoid.Last where
2142+ liftToJSON t to' = liftToJSON t to' . Monoid.getLast
2143+ {-# INLINE liftToJSON #-}
2145+ liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
2146+ {-# INLINE liftToEncoding #-}
2148+instance ToJSON a => ToJSON (Monoid.Last a) where
2150+ {-# INLINE toJSON #-}
2152+ toEncoding = toEncoding1
2153+ {-# INLINE toEncoding #-}
2156+instance ToJSON1 Semigroup.Min where
2157+ liftToJSON t _ (Semigroup.Min x) = t x
2158+ {-# INLINE liftToJSON #-}
2160+ liftToEncoding t _ (Semigroup.Min x) = t x
2161+ {-# INLINE liftToEncoding #-}
2163+instance ToJSON a => ToJSON (Semigroup.Min a) where
2165+ {-# INLINE toJSON #-}
2167+ toEncoding = toEncoding1
2168+ {-# INLINE toEncoding #-}
2171+instance ToJSON1 Semigroup.Max where
2172+ liftToJSON t _ (Semigroup.Max x) = t x
2173+ {-# INLINE liftToJSON #-}
2175+ liftToEncoding t _ (Semigroup.Max x) = t x
2176+ {-# INLINE liftToEncoding #-}
2178+instance ToJSON a => ToJSON (Semigroup.Max a) where
2180+ {-# INLINE toJSON #-}
2182+ toEncoding = toEncoding1
2183+ {-# INLINE toEncoding #-}
2185+instance ToJSON1 Semigroup.First where
2186+ liftToJSON t _ (Semigroup.First x) = t x
2187+ {-# INLINE liftToJSON #-}
2189+ liftToEncoding t _ (Semigroup.First x) = t x
2190+ {-# INLINE liftToEncoding #-}
2192+instance ToJSON a => ToJSON (Semigroup.First a) where
2194+ {-# INLINE toJSON #-}
2196+ toEncoding = toEncoding1
2197+ {-# INLINE toEncoding #-}
2200+instance ToJSON1 Semigroup.Last where
2201+ liftToJSON t _ (Semigroup.Last x) = t x
2202+ {-# INLINE liftToJSON #-}
2204+ liftToEncoding t _ (Semigroup.Last x) = t x
2205+ {-# INLINE liftToEncoding #-}
2207+instance ToJSON a => ToJSON (Semigroup.Last a) where
2209+ {-# INLINE toJSON #-}
2211+ toEncoding = toEncoding1
2212+ {-# INLINE toEncoding #-}
2215+instance ToJSON1 Semigroup.WrappedMonoid where
2216+ liftToJSON t _ (Semigroup.WrapMonoid x) = t x
2217+ {-# INLINE liftToJSON #-}
2219+ liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
2220+ {-# INLINE liftToEncoding #-}
2222+instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
2224+ {-# INLINE toJSON #-}
2226+ toEncoding = toEncoding1
2227+ {-# INLINE toEncoding #-}
2230+instance ToJSON1 Semigroup.Option where
2231+ liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
2232+ {-# INLINE liftToJSON #-}
2234+ liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
2235+ {-# INLINE liftToEncoding #-}
2237+instance ToJSON a => ToJSON (Semigroup.Option a) where
2239+ {-# INLINE toJSON #-}
2241+ toEncoding = toEncoding1
2242+ {-# INLINE toEncoding #-}
2244+-------------------------------------------------------------------------------
2246+-------------------------------------------------------------------------------
2248+instance ToJSON1 Proxy where
2249+ liftToJSON _ _ _ = Null
2250+ {-# INLINE liftToJSON #-}
2252+ liftToEncoding _ _ _ = E.null_
2253+ {-# INLINE liftToEncoding #-}
2255+instance ToJSON (Proxy a) where
2257+ {-# INLINE toJSON #-}
2259+ toEncoding _ = E.null_
2260+ {-# INLINE toEncoding #-}
2263+instance ToJSON2 Tagged where
2264+ liftToJSON2 _ _ t _ (Tagged x) = t x
2265+ {-# INLINE liftToJSON2 #-}
2267+ liftToEncoding2 _ _ t _ (Tagged x) = t x
2268+ {-# INLINE liftToEncoding2 #-}
2270+instance ToJSON1 (Tagged a) where
2271+ liftToJSON t _ (Tagged x) = t x
2272+ {-# INLINE liftToJSON #-}
2274+ liftToEncoding t _ (Tagged x) = t x
2275+ {-# INLINE liftToEncoding #-}
2277+instance ToJSON b => ToJSON (Tagged a b) where
2279+ {-# INLINE toJSON #-}
2281+ toEncoding = toEncoding1
2282+ {-# INLINE toEncoding #-}
2284+instance ToJSONKey b => ToJSONKey (Tagged a b) where
2285+ toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
2286+ toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
2288+-------------------------------------------------------------------------------
2289+-- Instances for converting t map keys
2290+-------------------------------------------------------------------------------
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)
2296+instance ToJSONKey Char where
2297+ toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
2298+ toJSONKeyList = toJSONKeyText T.pack
2300+instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
2301+ toJSONKey = toJSONKeyList
2303+-------------------------------------------------------------------------------
2305+-------------------------------------------------------------------------------
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)
2313+ {-# INLINE liftToJSON2 #-}
2315+ liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
2316+ {-# INLINE liftToEncoding2 #-}
2318+instance (ToJSON a) => ToJSON1 ((,) a) where
2319+ liftToJSON = liftToJSON2 toJSON toJSONList
2320+ {-# INLINE liftToJSON #-}
2321+ liftToEncoding = liftToEncoding2 toEncoding toEncodingList
2322+ {-# INLINE liftToEncoding #-}
2324+instance (ToJSON a, ToJSON b) => ToJSON (a, b) where
2326+ {-# INLINE toJSON #-}
2327+ toEncoding = toEncoding2
2328+ {-# INLINE toEncoding #-}
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)
2337+ {-# INLINE liftToJSON2 #-}
2339+ liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
2344+ {-# INLINE liftToEncoding2 #-}
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 #-}
2352+instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) where
2354+ {-# INLINE toJSON #-}
2355+ toEncoding = toEncoding2
2356+ {-# INLINE toEncoding #-}
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)
2366+ {-# INLINE liftToJSON2 #-}
2368+ liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
2374+ {-# INLINE liftToEncoding2 #-}
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 #-}
2382+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) where
2384+ {-# INLINE toJSON #-}
2385+ toEncoding = toEncoding2
2386+ {-# INLINE toEncoding #-}
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)
2397+ {-# INLINE liftToJSON2 #-}
2399+ liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
2406+ {-# INLINE liftToEncoding2 #-}
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 #-}
2414+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) where
2416+ {-# INLINE toJSON #-}
2417+ toEncoding = toEncoding2
2418+ {-# INLINE toEncoding #-}
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)
2430+ {-# INLINE liftToJSON2 #-}
2432+ liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
2440+ {-# INLINE liftToEncoding2 #-}
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 #-}
2448+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) where
2450+ {-# INLINE toJSON #-}
2451+ toEncoding = toEncoding2
2452+ {-# INLINE toEncoding #-}
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)
2465+ {-# INLINE liftToJSON2 #-}
2467+ liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
2476+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2486+ {-# INLINE toJSON #-}
2487+ toEncoding = toEncoding2
2488+ {-# INLINE toEncoding #-}
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)
2502+ {-# INLINE liftToJSON2 #-}
2504+ liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
2514+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2524+ {-# INLINE toJSON #-}
2525+ toEncoding = toEncoding2
2526+ {-# INLINE toEncoding #-}
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)
2541+ {-# INLINE liftToJSON2 #-}
2543+ liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
2554+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2564+ {-# INLINE toJSON #-}
2565+ toEncoding = toEncoding2
2566+ {-# INLINE toEncoding #-}
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)
2582+ {-# INLINE liftToJSON2 #-}
2584+ liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
2596+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2606+ {-# INLINE toJSON #-}
2607+ toEncoding = toEncoding2
2608+ {-# INLINE toEncoding #-}
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)
2625+ {-# INLINE liftToJSON2 #-}
2627+ liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
2640+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2650+ {-# INLINE toJSON #-}
2651+ toEncoding = toEncoding2
2652+ {-# INLINE toEncoding #-}
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)
2670+ {-# INLINE liftToJSON2 #-}
2672+ liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
2686+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2696+ {-# INLINE toJSON #-}
2697+ toEncoding = toEncoding2
2698+ {-# INLINE toEncoding #-}
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)
2717+ {-# INLINE liftToJSON2 #-}
2719+ liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
2734+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2744+ {-# INLINE toJSON #-}
2745+ toEncoding = toEncoding2
2746+ {-# INLINE toEncoding #-}
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)
2766+ {-# INLINE liftToJSON2 #-}
2768+ liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
2784+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2794+ {-# INLINE toJSON #-}
2795+ toEncoding = toEncoding2
2796+ {-# INLINE toEncoding #-}
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)
2817+ {-# INLINE liftToJSON2 #-}
2819+ liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
2836+ {-# INLINE liftToEncoding2 #-}
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 #-}
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
2846+ {-# INLINE toJSON #-}
2847+ toEncoding = toEncoding2
2848+ {-# INLINE toEncoding #-}
2850+--------------------------------------------------------------------------------
2852+-- | Wrap a list of pairs as an object.
2853+class Monoid pairs => FromPairs enc pairs | enc -> pairs where
2854+ fromPairs :: pairs -> enc
2856+instance (a ~ Value) => FromPairs (Encoding' a) Series where
2857+ fromPairs = E.pairs
2859+instance FromPairs Value (DList Pair) where
2860+ fromPairs = object . toList
2862+-- | Like 'KeyValue' but the value is already converted to JSON
2863+-- ('Value' or 'Encoding'), and the result actually represents lists of pairs
2864+-- so it can be readily concatenated.
2865+class Monoid kv => KeyValuePair v kv where
2866+ pair :: String -> v -> kv
2868+instance (v ~ Value) => KeyValuePair v (DList Pair) where
2869+ pair k v = DList.singleton (pack k .= v)
2871+instance (e ~ Encoding) => KeyValuePair e Series where