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