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