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