#if __GLASGOW_HASKELL__ >= 706
#endif
#include "overlapping-compat.h"
#include "incoherent-compat.h"
module Data.Aeson.Types.ToJSON
(
ToJSON(..)
, ToJSON1(..)
, toJSON1
, toEncoding1
, ToJSON2(..)
, toJSON2
, toEncoding2
, GToJSON(..)
, ToArgs(..)
, genericToJSON
, genericToEncoding
, genericLiftToJSON
, genericLiftToEncoding
, ToJSONKey(..)
, ToJSONKeyFunction(..)
, toJSONKeyText
, contramapToJSONKeyFunction
, KeyValue(..)
, listEncoding
, listValue
) where
import Prelude ()
import Prelude.Compat
import Control.Applicative (Const(..))
import Control.Monad.ST (ST)
import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
import Data.Aeson.Encoding.Internal ((>*<))
import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)
import Data.Aeson.Types.Generic (AllNullary, False, IsRecord(..), One, ProductSize, Tagged2(..), True, Zero, productSize)
import Data.Aeson.Types.Internal
import Data.Attoparsec.Number (Number(..))
import Data.Bits (unsafeShiftR)
import Data.DList (DList)
import Data.Fixed (Fixed, HasResolution)
import Data.Foldable (toList)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Product (Product(..))
import Data.Functor.Sum (Sum(..))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid ((<>))
import Data.Proxy (Proxy(..))
import Data.Ratio (Ratio, denominator, numerator)
import Data.Scientific (Scientific)
import Data.Tagged (Tagged(..))
import Data.Text (Text, pack)
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
import Data.Time.Format (FormatTime, formatTime)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Data.Vector (Vector)
import Data.Version (Version, showVersion)
import Data.Word (Word16, Word32, Word64, Word8)
import Foreign.Storable (Storable)
import Foreign.C.Types (CTime (..))
import GHC.Generics
import Numeric.Natural (Natural)
import qualified Data.Aeson.Encoding as E
import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.DList as DList
import qualified Data.HashMap.Strict as H
import qualified Data.HashSet as HashSet
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import qualified Data.Monoid as Monoid
import qualified Data.Scientific as Scientific
import qualified Data.Semigroup as Semigroup
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Tree as Tree
import qualified Data.UUID.Types as UUID
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import qualified Data.Aeson.Encoding.Builder as EB
import qualified Data.ByteString.Builder as B
#if !(MIN_VERSION_bytestring(0,10,0))
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (plusPtr)
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Lazy.Internal as L
#endif
toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
realFloatToJSON :: RealFloat a => a -> Value
realFloatToJSON d
| isNaN d || isInfinite d = Null
| otherwise = Number $ Scientific.fromFloatDigits d
class GToJSON enc arity f where
gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
data ToArgs res arity a where
NoToArgs :: ToArgs res Zero a
To1Args :: (a -> res) -> ([a] -> res) -> ToArgs res One a
genericToJSON :: (Generic a, GToJSON Value Zero (Rep a))
=> Options -> a -> Value
genericToJSON opts = gToJSON opts NoToArgs . from
genericLiftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
=> Options -> (a -> Value) -> ([a] -> Value)
-> f a -> Value
genericLiftToJSON opts tj tjl = gToJSON opts (To1Args tj tjl) . from1
genericToEncoding :: (Generic a, GToJSON Encoding Zero (Rep a))
=> Options -> a -> Encoding
genericToEncoding opts = gToJSON opts NoToArgs . from
genericLiftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
=> Options -> (a -> Encoding) -> ([a] -> Encoding)
-> f a -> Encoding
genericLiftToEncoding opts te tel = gToJSON opts (To1Args te tel) . from1
class ToJSON a where
toJSON :: a -> Value
default toJSON :: (Generic a, GToJSON Value Zero (Rep a)) => a -> Value
toJSON = genericToJSON defaultOptions
toEncoding :: a -> Encoding
toEncoding = E.value . toJSON
toJSONList :: [a] -> Value
toJSONList = listValue toJSON
toEncodingList :: [a] -> Encoding
toEncodingList = listEncoding toEncoding
class KeyValue kv where
(.=) :: ToJSON v => Text -> v -> kv
infixr 8 .=
instance KeyValue Series where
name .= value = E.pair name (toEncoding value)
instance KeyValue Pair where
name .= value = (name, toJSON value)
class ToJSONKey a where
toJSONKey :: ToJSONKeyFunction a
default toJSONKey :: ToJSON a => ToJSONKeyFunction a
toJSONKey = ToJSONKeyValue toJSON toEncoding
toJSONKeyList :: ToJSONKeyFunction [a]
default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
toJSONKeyList = ToJSONKeyValue toJSON toEncoding
data ToJSONKeyFunction a
= ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)
| ToJSONKeyValue !(a -> Value) !(a -> Encoding)
toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText f = ToJSONKeyText f (E.text . f)
toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a
toJSONKeyTextEnc e = ToJSONKeyText tot e
where
tot = T.dropAround (== '"')
. T.decodeLatin1
. lazyToStrictByteString
. E.encodingToLazyByteString
. e
contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
contramapToJSONKeyFunction h x = case x of
ToJSONKeyText f g -> ToJSONKeyText (f . h) (g . h)
ToJSONKeyValue f g -> ToJSONKeyValue (f . h) (g . h)
class ToJSON1 f where
liftToJSON :: (a -> Value) -> ([a] -> Value) -> f a -> Value
default liftToJSON :: (Generic1 f, GToJSON Value One (Rep1 f))
=> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON = genericLiftToJSON defaultOptions
liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList f g = listValue (liftToJSON f g)
liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
default liftToEncoding :: (Generic1 f, GToJSON Encoding One (Rep1 f))
=> (a -> Encoding) -> ([a] -> Encoding)
-> f a -> Encoding
liftToEncoding = genericLiftToEncoding defaultOptions
liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList f g = listEncoding (liftToEncoding f g)
toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1 = liftToJSON toJSON toJSONList
toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1 = liftToEncoding toEncoding toEncodingList
class ToJSON2 f where
liftToJSON2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
liftToJSONList2 :: (a -> Value) -> ([a] -> Value) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
liftToJSONList2 fa ga fb gb = listValue (liftToJSON2 fa ga fb gb)
liftToEncoding2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding
liftToEncodingList2 :: (a -> Encoding) -> ([a] -> Encoding) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding
liftToEncodingList2 fa ga fb gb = listEncoding (liftToEncoding2 fa ga fb gb)
toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value
toJSON2 = liftToJSON2 toJSON toJSONList toJSON toJSONList
toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding
toEncoding2 = liftToEncoding2 toEncoding toEncodingList toEncoding toEncodingList
listEncoding :: (a -> Encoding) -> [a] -> Encoding
listEncoding = E.list
listValue :: (a -> Value) -> [a] -> Value
listValue f = Array . V.fromList . map f
instance ToJSON1 [] where
liftToJSON _ to' = to'
liftToEncoding _ to' = to'
instance (ToJSON a) => ToJSON [a] where
toJSON = toJSON1
toEncoding = toEncoding1
instance OVERLAPPABLE_ (GToJSON enc arity a) => GToJSON enc arity (M1 i c a) where
gToJSON opts targs = gToJSON opts targs . unM1
instance GToJSON enc One Par1 where
gToJSON _opts (To1Args tj _) = tj . unPar1
instance ( ConsToJSON enc arity a
, AllNullary (C1 c a) allNullary
, SumToJSON enc arity (C1 c a) allNullary
) => GToJSON enc arity (D1 d (C1 c a)) where
gToJSON opts targs
| tagSingleConstructors opts = (unTagged :: Tagged allNullary enc -> enc)
. sumToJSON opts targs
. unM1
| otherwise = consToJSON opts targs . unM1 . unM1
instance (ConsToJSON enc arity a) => GToJSON enc arity (C1 c a) where
gToJSON opts targs = consToJSON opts targs . unM1
instance ( AllNullary (a :+: b) allNullary
, SumToJSON enc arity (a :+: b) allNullary
) => GToJSON enc arity (a :+: b)
where
gToJSON opts targs = (unTagged :: Tagged allNullary enc -> enc)
. sumToJSON opts targs
instance ToJSON a => GToJSON Value arity (K1 i a) where
gToJSON _opts _ = toJSON . unK1
instance ToJSON1 f => GToJSON Value One (Rec1 f) where
gToJSON _opts (To1Args tj tjl) = liftToJSON tj tjl . unRec1
instance GToJSON Value arity U1 where
gToJSON _opts _ _ = emptyArray
instance ( WriteProduct arity a, WriteProduct arity b
, ProductSize a, ProductSize b
) => GToJSON Value arity (a :*: b)
where
gToJSON opts targs p =
Array $ V.create $ do
mv <- VM.unsafeNew lenProduct
writeProduct opts targs mv 0 lenProduct p
return mv
where
lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
productSize
instance ( ToJSON1 f
, GToJSON Value One g
) => GToJSON Value One (f :.: g)
where
gToJSON opts targs =
let gtj = gToJSON opts targs in
liftToJSON gtj (listValue gtj) . unComp1
instance ToJSON a => GToJSON Encoding arity (K1 i a) where
gToJSON _opts _ = toEncoding . unK1
instance ToJSON1 f => GToJSON Encoding One (Rec1 f) where
gToJSON _opts (To1Args te tel) = liftToEncoding te tel . unRec1
instance GToJSON Encoding arity U1 where
gToJSON _opts _ _ = E.emptyArray_
instance ( EncodeProduct arity a
, EncodeProduct arity b
) => GToJSON Encoding arity (a :*: b)
where
gToJSON opts targs p = E.list E.retagEncoding [encodeProduct opts targs p]
instance ( ToJSON1 f
, GToJSON Encoding One g
) => GToJSON Encoding One (f :.: g)
where
gToJSON opts targs =
let gte = gToJSON opts targs in
liftToEncoding gte (listEncoding gte) . unComp1
class SumToJSON enc arity f allNullary where
sumToJSON :: Options -> ToArgs enc arity a
-> f a -> Tagged allNullary enc
instance ( GetConName f
, FromString enc
, TaggedObject enc arity f
, SumToJSON' ObjectWithSingleField enc arity f
, SumToJSON' TwoElemArray enc arity f
, SumToJSON' UntaggedValue enc arity f
) => SumToJSON enc arity f True
where
sumToJSON opts targs
| allNullaryToStringTag opts = Tagged . fromString
. constructorTagModifier opts . getConName
| otherwise = Tagged . nonAllNullarySumToJSON opts targs
instance ( TaggedObject enc arity f
, SumToJSON' ObjectWithSingleField enc arity f
, SumToJSON' TwoElemArray enc arity f
, SumToJSON' UntaggedValue enc arity f
) => SumToJSON enc arity f False
where
sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs
nonAllNullarySumToJSON :: ( TaggedObject enc arity f
, SumToJSON' ObjectWithSingleField enc arity f
, SumToJSON' TwoElemArray enc arity f
, SumToJSON' UntaggedValue enc arity f
) => Options -> ToArgs enc arity a
-> f a -> enc
nonAllNullarySumToJSON opts targs =
case sumEncoding opts of
TaggedObject{..} ->
taggedObject opts targs tagFieldName contentsFieldName
ObjectWithSingleField ->
(unTagged :: Tagged ObjectWithSingleField enc -> enc)
. sumToJSON' opts targs
TwoElemArray ->
(unTagged :: Tagged TwoElemArray enc -> enc)
. sumToJSON' opts targs
UntaggedValue ->
(unTagged :: Tagged UntaggedValue enc -> enc)
. sumToJSON' opts targs
class FromString enc where
fromString :: String -> enc
instance FromString Encoding where
fromString = toEncoding
instance FromString Value where
fromString = String . pack
class TaggedObject enc arity f where
taggedObject :: Options -> ToArgs enc arity a
-> String -> String
-> f a -> enc
instance ( TaggedObject enc arity a
, TaggedObject enc arity b
) => TaggedObject enc arity (a :+: b)
where
taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
taggedObject opts targs tagFieldName contentsFieldName x
taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
taggedObject opts targs tagFieldName contentsFieldName x
instance ( IsRecord a isRecord
, TaggedObject' enc pairs arity a isRecord
, FromPairs enc pairs
, FromString enc
, GKeyValue enc pairs
, Constructor c
) => TaggedObject enc arity (C1 c a)
where
taggedObject opts targs tagFieldName contentsFieldName =
fromPairs . (tag <>) . contents
where
tag = tagFieldName `gPair`
(fromString (constructorTagModifier opts (conName (undefined :: t c a p)))
:: enc)
contents =
(unTagged :: Tagged isRecord pairs -> pairs) .
taggedObject' opts targs contentsFieldName . unM1
class TaggedObject' enc pairs arity f isRecord where
taggedObject' :: Options -> ToArgs enc arity a
-> String -> f a -> Tagged isRecord pairs
instance ( GToJSON enc arity f
, GKeyValue enc pairs
) => TaggedObject' enc pairs arity f False
where
taggedObject' opts targs contentsFieldName =
Tagged . (contentsFieldName `gPair`) . gToJSON opts targs
instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where
taggedObject' _ _ _ _ = Tagged mempty
instance ( RecordToPairs enc pairs arity f
) => TaggedObject' enc pairs arity f True
where
taggedObject' opts targs _ = Tagged . recordToPairs opts targs
class GetConName f where
getConName :: f a -> String
instance (GetConName a, GetConName b) => GetConName (a :+: b) where
getConName (L1 x) = getConName x
getConName (R1 x) = getConName x
instance (Constructor c) => GetConName (C1 c a) where
getConName = conName
data ObjectWithSingleField
data TwoElemArray
data UntaggedValue
class SumToJSON' s enc arity f where
sumToJSON' :: Options -> ToArgs enc arity a
-> f a -> Tagged s enc
instance ( SumToJSON' s enc arity a
, SumToJSON' s enc arity b
) => SumToJSON' s enc arity (a :+: b)
where
sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x
sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x
instance ( GToJSON Value arity a
, ConsToJSON Value arity a
, Constructor c
) => SumToJSON' TwoElemArray Value arity (C1 c a) where
sumToJSON' opts targs x = Tagged $ Array $ V.create $ do
mv <- VM.unsafeNew 2
VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
$ conName (undefined :: t c a p)
VM.unsafeWrite mv 1 $ gToJSON opts targs x
return mv
instance ( GToJSON Encoding arity a
, ConsToJSON Encoding arity a
, Constructor c
) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
where
sumToJSON' opts targs x = Tagged $ E.list id
[ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))
, gToJSON opts targs x
]
class ConsToJSON enc arity f where
consToJSON :: Options -> ToArgs enc arity a
-> f a -> enc
class ConsToJSON' enc arity f isRecord where
consToJSON' :: Options -> ToArgs enc arity a
-> Bool
-> f a -> Tagged isRecord enc
instance ( IsRecord f isRecord
, ConsToJSON' enc arity f isRecord
) => ConsToJSON enc arity f
where
consToJSON opts targs =
(unTagged :: Tagged isRecord enc -> enc)
. consToJSON' opts targs (isUnary (undefined :: f a))
instance ( RecordToPairs enc pairs arity f
, FromPairs enc pairs
, GToJSON enc arity f
) => ConsToJSON' enc arity f True
where
consToJSON' opts targs isUn =
Tagged .
case (isUn, unwrapUnaryRecords opts) of
(True, True) -> gToJSON opts targs
_ -> fromPairs . recordToPairs opts targs
instance GToJSON enc arity f => ConsToJSON' enc arity f False where
consToJSON' opts targs _ = Tagged . gToJSON opts targs
class RecordToPairs enc pairs arity f where
recordToPairs :: Options -> ToArgs enc arity a
-> f a -> pairs
instance ( Monoid pairs
, RecordToPairs enc pairs arity a
, RecordToPairs enc pairs arity b
) => RecordToPairs enc pairs arity (a :*: b)
where
recordToPairs opts (targs :: ToArgs enc arity p) (a :*: b) =
pairsOf a <> pairsOf b
where
pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
pairsOf = recordToPairs opts targs
instance ( Selector s
, GToJSON enc arity a
, GKeyValue enc pairs
) => RecordToPairs enc pairs arity (S1 s a)
where
recordToPairs = fieldToPair
instance INCOHERENT_
( Selector s
, GToJSON enc arity (K1 i (Maybe a))
, GKeyValue enc pairs
, Monoid pairs
) => RecordToPairs enc pairs arity (S1 s (K1 i (Maybe a)))
where
recordToPairs opts _ (M1 k1) | omitNothingFields opts
, K1 Nothing <- k1 = mempty
recordToPairs opts targs m1 = fieldToPair opts targs m1
instance INCOHERENT_
( Selector s
, GToJSON enc arity (K1 i (Maybe a))
, GKeyValue enc pairs
, Monoid pairs
) => RecordToPairs enc pairs arity (S1 s (K1 i (Semigroup.Option a)))
where
recordToPairs opts targs = recordToPairs opts targs . unwrap
where
unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p
unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)
fieldToPair :: (Selector s
, GToJSON enc arity a
, GKeyValue enc pairs)
=> Options -> ToArgs enc arity p
-> S1 s a p -> pairs
fieldToPair opts targs m1 =
let key = fieldLabelModifier opts (selName m1)
value = gToJSON opts targs (unM1 m1)
in key `gPair` value
class WriteProduct arity f where
writeProduct :: Options
-> ToArgs Value arity a
-> VM.MVector s Value
-> Int
-> Int
-> f a
-> ST s ()
instance ( WriteProduct arity a
, WriteProduct arity b
) => WriteProduct arity (a :*: b) where
writeProduct opts targs mv ix len (a :*: b) = do
writeProduct opts targs mv ix lenL a
writeProduct opts targs mv ixR lenR b
where
lenL = len `unsafeShiftR` 1
lenR = len lenL
ixR = ix + lenL
instance OVERLAPPABLE_ (GToJSON Value arity a) => WriteProduct arity a where
writeProduct opts targs mv ix _ =
VM.unsafeWrite mv ix . gToJSON opts targs
class EncodeProduct arity f where
encodeProduct :: Options -> ToArgs Encoding arity a
-> f a -> Encoding' E.InArray
instance ( EncodeProduct arity a
, EncodeProduct arity b
) => EncodeProduct arity (a :*: b) where
encodeProduct opts targs (a :*: b) | omitNothingFields opts =
E.econcat $ intersperse E.comma $
filter (not . E.nullEncoding)
[encodeProduct opts targs a, encodeProduct opts targs b]
encodeProduct opts targs (a :*: b) =
encodeProduct opts targs a >*<
encodeProduct opts targs b
instance OVERLAPPABLE_ (GToJSON Encoding arity a) => EncodeProduct arity a where
encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a
instance ( GToJSON enc arity a
, ConsToJSON enc arity a
, FromPairs enc pairs
, GKeyValue enc pairs
, Constructor c
) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
where
sumToJSON' opts targs =
Tagged . fromPairs . (typ `gPair`) . gToJSON opts targs
where
typ = constructorTagModifier opts $
conName (undefined :: t c a p)
instance OVERLAPPABLE_
( ConsToJSON enc arity a
) => SumToJSON' UntaggedValue enc arity (C1 c a)
where
sumToJSON' opts targs = Tagged . gToJSON opts targs
instance OVERLAPPING_
( Constructor c
, FromString enc
) => SumToJSON' UntaggedValue enc arity (C1 c U1)
where
sumToJSON' opts _ _ = Tagged . fromString $
constructorTagModifier opts $ conName (undefined :: t c U1 p)
instance ToJSON2 Const where
liftToJSON2 t _ _ _ (Const x) = t x
liftToEncoding2 t _ _ _ (Const x) = t x
instance ToJSON a => ToJSON1 (Const a) where
liftToJSON _ _ (Const x) = toJSON x
liftToEncoding _ _ (Const x) = toEncoding x
instance ToJSON a => ToJSON (Const a b) where
toJSON (Const x) = toJSON x
toEncoding (Const x) = toEncoding x
instance ToJSON1 Maybe where
liftToJSON t _ (Just a) = t a
liftToJSON _ _ Nothing = Null
liftToEncoding t _ (Just a) = t a
liftToEncoding _ _ Nothing = E.null_
instance (ToJSON a) => ToJSON (Maybe a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON2 Either where
liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)
liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)
liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a
liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b
instance (ToJSON a) => ToJSON1 (Either a) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
toJSON = toJSON2
toEncoding = toEncoding2
instance ToJSON Bool where
toJSON = Bool
toEncoding = E.bool
instance ToJSONKey Bool where
toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"
instance ToJSON Ordering where
toJSON = toJSON . orderingToText
toEncoding = toEncoding . orderingToText
orderingToText :: Ordering -> T.Text
orderingToText o = case o of
LT -> "LT"
EQ -> "EQ"
GT -> "GT"
instance ToJSON () where
toJSON _ = emptyArray
toEncoding _ = emptyArray_
instance ToJSON Char where
toJSON = String . T.singleton
toJSONList = String . T.pack
toEncoding = E.string . (:[])
toEncodingList = E.string
instance ToJSON Double where
toJSON = realFloatToJSON
toEncoding = E.double
instance ToJSONKey Double where
toJSONKey = toJSONKeyTextEnc E.doubleText
instance ToJSON Number where
toJSON (D d) = toJSON d
toJSON (I i) = toJSON i
toEncoding (D d) = toEncoding d
toEncoding (I i) = toEncoding i
instance ToJSON Float where
toJSON = realFloatToJSON
toEncoding = E.float
instance ToJSONKey Float where
toJSONKey = toJSONKeyTextEnc E.floatText
instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
toJSON r = object [ "numerator" .= numerator r
, "denominator" .= denominator r
]
toEncoding r = E.pairs $
"numerator" .= numerator r <>
"denominator" .= denominator r
instance HasResolution a => ToJSON (Fixed a) where
toJSON = Number . realToFrac
toEncoding = E.scientific . realToFrac
instance HasResolution a => ToJSONKey (Fixed a) where
toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)
instance ToJSON Int where
toJSON = Number . fromIntegral
toEncoding = E.int
instance ToJSONKey Int where
toJSONKey = toJSONKeyTextEnc E.intText
instance ToJSON Integer where
toJSON = Number . fromInteger
toEncoding = E.integer
instance ToJSONKey Integer where
toJSONKey = toJSONKeyTextEnc E.integerText
instance ToJSON Natural where
toJSON = toJSON . toInteger
toEncoding = toEncoding . toInteger
instance ToJSONKey Natural where
toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)
instance ToJSON Int8 where
toJSON = Number . fromIntegral
toEncoding = E.int8
instance ToJSONKey Int8 where
toJSONKey = toJSONKeyTextEnc E.int8Text
instance ToJSON Int16 where
toJSON = Number . fromIntegral
toEncoding = E.int16
instance ToJSONKey Int16 where
toJSONKey = toJSONKeyTextEnc E.int16Text
instance ToJSON Int32 where
toJSON = Number . fromIntegral
toEncoding = E.int32
instance ToJSONKey Int32 where
toJSONKey = toJSONKeyTextEnc E.int32Text
instance ToJSON Int64 where
toJSON = Number . fromIntegral
toEncoding = E.int64
instance ToJSONKey Int64 where
toJSONKey = toJSONKeyTextEnc E.int64Text
instance ToJSON Word where
toJSON = Number . fromIntegral
toEncoding = E.word
instance ToJSONKey Word where
toJSONKey = toJSONKeyTextEnc E.wordText
instance ToJSON Word8 where
toJSON = Number . fromIntegral
toEncoding = E.word8
instance ToJSONKey Word8 where
toJSONKey = toJSONKeyTextEnc E.word8Text
instance ToJSON Word16 where
toJSON = Number . fromIntegral
toEncoding = E.word16
instance ToJSONKey Word16 where
toJSONKey = toJSONKeyTextEnc E.word16Text
instance ToJSON Word32 where
toJSON = Number . fromIntegral
toEncoding = E.word32
instance ToJSONKey Word32 where
toJSONKey = toJSONKeyTextEnc E.word32Text
instance ToJSON Word64 where
toJSON = Number . fromIntegral
toEncoding = E.word64
instance ToJSONKey Word64 where
toJSONKey = toJSONKeyTextEnc E.word64Text
instance ToJSON CTime where
toJSON (CTime i) = toJSON i
toEncoding (CTime i) = toEncoding i
instance ToJSON Text where
toJSON = String
toEncoding = E.text
instance ToJSONKey Text where
toJSONKey = toJSONKeyText id
instance ToJSON LT.Text where
toJSON = String . LT.toStrict
toEncoding = E.lazyText
instance ToJSONKey LT.Text where
toJSONKey = toJSONKeyText LT.toStrict
instance ToJSON Version where
toJSON = toJSON . showVersion
toEncoding = toEncoding . showVersion
instance ToJSONKey Version where
toJSONKey = toJSONKeyText (T.pack . showVersion)
instance ToJSON1 NonEmpty where
liftToJSON t _ = listValue t . NE.toList
liftToEncoding t _ = listEncoding t . NE.toList
instance (ToJSON a) => ToJSON (NonEmpty a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON Scientific where
toJSON = Number
toEncoding = E.scientific
instance ToJSONKey Scientific where
toJSONKey = toJSONKeyTextEnc E.scientificText
instance ToJSON1 DList.DList where
liftToJSON t _ = listValue t . toList
liftToEncoding t _ = listEncoding t . toList
instance (ToJSON a) => ToJSON (DList.DList a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Identity where
liftToJSON t _ (Identity a) = t a
liftToJSONList _ tl xs = tl (map runIdentity xs)
liftToEncoding t _ (Identity a) = t a
liftToEncodingList _ tl xs = tl (map runIdentity xs)
instance (ToJSON a) => ToJSON (Identity a) where
toJSON = toJSON1
toJSONList = liftToJSONList toJSON toJSONList
toEncoding = toEncoding1
toEncodingList = liftToEncodingList toEncoding toEncodingList
instance (ToJSONKey a) => ToJSONKey (Identity a) where
toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey
toJSONKeyList = contramapToJSONKeyFunction (map runIdentity) toJSONKeyList
instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
liftToJSON tv tvl (Compose x) = liftToJSON g gl x
where
g = liftToJSON tv tvl
gl = liftToJSONList tv tvl
liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)
where
g = liftToJSON te tel
gl = liftToJSONList te tel
liftToEncoding te tel (Compose x) = liftToEncoding g gl x
where
g = liftToEncoding te tel
gl = liftToEncodingList te tel
liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)
where
g = liftToEncoding te tel
gl = liftToEncodingList te tel
instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
toJSON = toJSON1
toJSONList = liftToJSONList toJSON toJSONList
toEncoding = toEncoding1
toEncodingList = liftToEncodingList toEncoding toEncodingList
instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where
liftToJSON tv tvl (Pair x y) = liftToJSON2 tx txl ty tyl (x, y)
where
tx = liftToJSON tv tvl
txl = liftToJSONList tv tvl
ty = liftToJSON tv tvl
tyl = liftToJSONList tv tvl
liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)
where
tx = liftToEncoding te tel
txl = liftToEncodingList te tel
ty = liftToEncoding te tel
tyl = liftToEncodingList te tel
instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where
liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)
liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)
liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x
liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y
instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Seq.Seq where
liftToJSON t _ = listValue t . toList
liftToEncoding t _ = listEncoding t . toList
instance (ToJSON a) => ToJSON (Seq.Seq a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Set.Set where
liftToJSON t _ = listValue t . Set.toList
liftToEncoding t _ = listEncoding t . Set.toList
instance (ToJSON a) => ToJSON (Set.Set a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON IntSet.IntSet where
toJSON = toJSON . IntSet.toList
toEncoding = toEncoding . IntSet.toList
instance ToJSON1 IntMap.IntMap where
liftToJSON t tol = liftToJSON to' tol' . IntMap.toList
where
to' = liftToJSON2 toJSON toJSONList t tol
tol' = liftToJSONList2 toJSON toJSONList t tol
liftToEncoding t tol = liftToEncoding to' tol' . IntMap.toList
where
to' = liftToEncoding2 toEncoding toEncodingList t tol
tol' = liftToEncodingList2 toEncoding toEncodingList t tol
instance ToJSON a => ToJSON (IntMap.IntMap a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSONKey k => ToJSON1 (M.Map k) where
liftToJSON g _ = case toJSONKey of
ToJSONKeyText f _ -> Object . mapHashKeyVal f g
ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList
liftToEncoding g _ = case toJSONKey of
ToJSONKeyText _ f -> dict f g M.foldrWithKey
ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList
where
pairEncoding f (a, b) = E.list id [f a, g b]
instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Tree.Tree where
liftToJSON t tol = go
where
go (Tree.Node root branches) =
liftToJSON2 t tol to' tol' (root, branches)
to' = liftToJSON go (listValue go)
tol' = liftToJSONList go (listValue go)
liftToEncoding t tol = go
where
go (Tree.Node root branches) =
liftToEncoding2 t tol to' tol' (root, branches)
to' = liftToEncoding go (listEncoding go)
tol' = liftToEncodingList go (listEncoding go)
instance (ToJSON v) => ToJSON (Tree.Tree v) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON UUID.UUID where
toJSON = toJSON . UUID.toText
toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
instance ToJSONKey UUID.UUID where
toJSONKey = ToJSONKeyText UUID.toText $
E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
instance ToJSON1 Vector where
liftToJSON t _ = Array . V.map t
liftToEncoding t _ = listEncoding t . V.toList
instance (ToJSON a) => ToJSON (Vector a) where
toJSON = toJSON1
toEncoding = toEncoding1
encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
encodeVector = listEncoding toEncoding . VG.toList
vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
vectorToJSON = Array . V.map toJSON . V.convert
instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
toJSON = vectorToJSON
toEncoding = encodeVector
instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
toJSON = vectorToJSON
toEncoding = encodeVector
instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
toJSON = vectorToJSON
toEncoding = encodeVector
instance ToJSON1 HashSet.HashSet where
liftToJSON t _ = listValue t . HashSet.toList
liftToEncoding t _ = listEncoding t . HashSet.toList
instance (ToJSON a) => ToJSON (HashSet.HashSet a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSONKey k => ToJSON1 (H.HashMap k) where
liftToJSON g _ = case toJSONKey of
ToJSONKeyText f _ -> Object . mapKeyVal f g
ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList
liftToEncoding g _ = case toJSONKey of
ToJSONKeyText _ f -> dict f g H.foldrWithKey
ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList
where
pairEncoding f (a, b) = E.list id [f a, g b]
instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON Value where
toJSON a = a
toEncoding = E.value
instance ToJSON DotNetTime where
toJSON = toJSON . dotNetTime
toEncoding = toEncoding . dotNetTime
dotNetTime :: DotNetTime -> String
dotNetTime (DotNetTime t) = secs ++ formatMillis t ++ ")/"
where secs = formatTime defaultTimeLocale "/Date(%s" t
formatMillis :: (FormatTime t) => t -> String
formatMillis = take 3 . formatTime defaultTimeLocale "%q"
instance ToJSON Day where
toJSON = stringEncoding . E.day
toEncoding = E.day
instance ToJSONKey Day where
toJSONKey = toJSONKeyTextEnc E.day
instance ToJSON TimeOfDay where
toJSON = stringEncoding . E.timeOfDay
toEncoding = E.timeOfDay
instance ToJSONKey TimeOfDay where
toJSONKey = toJSONKeyTextEnc E.timeOfDay
instance ToJSON LocalTime where
toJSON = stringEncoding . E.localTime
toEncoding = E.localTime
instance ToJSONKey LocalTime where
toJSONKey = toJSONKeyTextEnc E.localTime
instance ToJSON ZonedTime where
toJSON = stringEncoding . E.zonedTime
toEncoding = E.zonedTime
instance ToJSONKey ZonedTime where
toJSONKey = toJSONKeyTextEnc E.zonedTime
instance ToJSON UTCTime where
toJSON = stringEncoding . E.utcTime
toEncoding = E.utcTime
instance ToJSONKey UTCTime where
toJSONKey = toJSONKeyTextEnc E.utcTime
stringEncoding :: Encoding' Text -> Value
stringEncoding = String
. T.dropAround (== '"')
. T.decodeLatin1
. lazyToStrictByteString
. E.encodingToLazyByteString
instance ToJSON NominalDiffTime where
toJSON = Number . realToFrac
toEncoding = E.scientific . realToFrac
instance ToJSON DiffTime where
toJSON = Number . realToFrac
toEncoding = E.scientific . realToFrac
instance ToJSON1 Monoid.Dual where
liftToJSON t _ = t . Monoid.getDual
liftToEncoding t _ = t . Monoid.getDual
instance ToJSON a => ToJSON (Monoid.Dual a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Monoid.First where
liftToJSON t to' = liftToJSON t to' . Monoid.getFirst
liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst
instance ToJSON a => ToJSON (Monoid.First a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Monoid.Last where
liftToJSON t to' = liftToJSON t to' . Monoid.getLast
liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast
instance ToJSON a => ToJSON (Monoid.Last a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Semigroup.Min where
liftToJSON t _ (Semigroup.Min x) = t x
liftToEncoding t _ (Semigroup.Min x) = t x
instance ToJSON a => ToJSON (Semigroup.Min a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Semigroup.Max where
liftToJSON t _ (Semigroup.Max x) = t x
liftToEncoding t _ (Semigroup.Max x) = t x
instance ToJSON a => ToJSON (Semigroup.Max a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Semigroup.First where
liftToJSON t _ (Semigroup.First x) = t x
liftToEncoding t _ (Semigroup.First x) = t x
instance ToJSON a => ToJSON (Semigroup.First a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Semigroup.Last where
liftToJSON t _ (Semigroup.Last x) = t x
liftToEncoding t _ (Semigroup.Last x) = t x
instance ToJSON a => ToJSON (Semigroup.Last a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Semigroup.WrappedMonoid where
liftToJSON t _ (Semigroup.WrapMonoid x) = t x
liftToEncoding t _ (Semigroup.WrapMonoid x) = t x
instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Semigroup.Option where
liftToJSON t to' = liftToJSON t to' . Semigroup.getOption
liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption
instance ToJSON a => ToJSON (Semigroup.Option a) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSON1 Proxy where
liftToJSON _ _ _ = Null
liftToEncoding _ _ _ = E.null_
instance ToJSON (Proxy a) where
toJSON _ = Null
toEncoding _ = E.null_
instance ToJSON2 Tagged where
liftToJSON2 _ _ t _ (Tagged x) = t x
liftToEncoding2 _ _ t _ (Tagged x) = t x
instance ToJSON1 (Tagged a) where
liftToJSON t _ (Tagged x) = t x
liftToEncoding t _ (Tagged x) = t x
instance ToJSON b => ToJSON (Tagged a b) where
toJSON = toJSON1
toEncoding = toEncoding1
instance ToJSONKey b => ToJSONKey (Tagged a b) where
toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey
toJSONKeyList = contramapToJSONKeyFunction (fmap unTagged) toJSONKeyList
instance (ToJSON a, ToJSON b) => ToJSONKey (a,b)
instance (ToJSON a, ToJSON b, ToJSON c) => ToJSONKey (a,b,c)
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)
instance ToJSONKey Char where
toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))
toJSONKeyList = toJSONKeyText T.pack
instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where
toJSONKey = toJSONKeyList
instance ToJSON2 (,) where
liftToJSON2 toA _ toB _ (a, b) = Array $ V.create $ do
mv <- VM.unsafeNew 2
VM.unsafeWrite mv 0 (toA a)
VM.unsafeWrite mv 1 (toB b)
return mv
liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]
instance (ToJSON a) => ToJSON1 ((,) a) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b) => ToJSON (a, b) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a) => ToJSON2 ((,,) a) where
liftToJSON2 toB _ toC _ (a, b, c) = Array $ V.create $ do
mv <- VM.unsafeNew 3
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toB b)
VM.unsafeWrite mv 2 (toC c)
return mv
liftToEncoding2 toB _ toC _ (a, b, c) = E.list id
[ toEncoding a
, toB b
, toC c
]
instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where
liftToJSON2 toC _ toD _ (a, b, c, d) = Array $ V.create $ do
mv <- VM.unsafeNew 4
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toC c)
VM.unsafeWrite mv 3 (toD d)
return mv
liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id
[ toEncoding a
, toEncoding b
, toC c
, toD d
]
instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where
liftToJSON2 toD _ toE _ (a, b, c, d, e) = Array $ V.create $ do
mv <- VM.unsafeNew 5
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toD d)
VM.unsafeWrite mv 4 (toE e)
return mv
liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toD d
, toE e
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) where
liftToJSON2 toE _ toF _ (a, b, c, d, e, f) = Array $ V.create $ do
mv <- VM.unsafeNew 6
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toE e)
VM.unsafeWrite mv 5 (toF f)
return mv
liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toE e
, toF f
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,) a b c d e) where
liftToJSON2 toF _ toG _ (a, b, c, d, e, f, g) = Array $ V.create $ do
mv <- VM.unsafeNew 7
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toF f)
VM.unsafeWrite mv 6 (toG g)
return mv
liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toF f
, toG g
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2 ((,,,,,,,) a b c d e f) where
liftToJSON2 toG _ toH _ (a, b, c, d, e, f, g, h) = Array $ V.create $ do
mv <- VM.unsafeNew 8
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toG g)
VM.unsafeWrite mv 7 (toH h)
return mv
liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toG g
, toH h
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON (a, b, c, d, e, f, g, h) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON2 ((,,,,,,,,) a b c d e f g) where
liftToJSON2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = Array $ V.create $ do
mv <- VM.unsafeNew 9
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toH h)
VM.unsafeWrite mv 8 (toI i)
return mv
liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toH h
, toI i
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON (a, b, c, d, e, f, g, h, i) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON2 ((,,,,,,,,,) a b c d e f g h) where
liftToJSON2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = Array $ V.create $ do
mv <- VM.unsafeNew 10
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toJSON h)
VM.unsafeWrite mv 8 (toI i)
VM.unsafeWrite mv 9 (toJ j)
return mv
liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toEncoding h
, toI i
, toJ j
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON (a, b, c, d, e, f, g, h, i, j) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON2 ((,,,,,,,,,,) a b c d e f g h i) where
liftToJSON2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = Array $ V.create $ do
mv <- VM.unsafeNew 11
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toJSON h)
VM.unsafeWrite mv 8 (toJSON i)
VM.unsafeWrite mv 9 (toJ j)
VM.unsafeWrite mv 10 (toK k)
return mv
liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toEncoding h
, toEncoding i
, toJ j
, toK k
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON (a, b, c, d, e, f, g, h, i, j, k) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where
liftToJSON2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = Array $ V.create $ do
mv <- VM.unsafeNew 12
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toJSON h)
VM.unsafeWrite mv 8 (toJSON i)
VM.unsafeWrite mv 9 (toJSON j)
VM.unsafeWrite mv 10 (toK k)
VM.unsafeWrite mv 11 (toL l)
return mv
liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toEncoding h
, toEncoding i
, toEncoding j
, toK k
, toL l
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where
liftToJSON2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = Array $ V.create $ do
mv <- VM.unsafeNew 13
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toJSON h)
VM.unsafeWrite mv 8 (toJSON i)
VM.unsafeWrite mv 9 (toJSON j)
VM.unsafeWrite mv 10 (toJSON k)
VM.unsafeWrite mv 11 (toL l)
VM.unsafeWrite mv 12 (toM m)
return mv
liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toEncoding h
, toEncoding i
, toEncoding j
, toEncoding k
, toL l
, toM m
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where
liftToJSON2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = Array $ V.create $ do
mv <- VM.unsafeNew 14
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toJSON h)
VM.unsafeWrite mv 8 (toJSON i)
VM.unsafeWrite mv 9 (toJSON j)
VM.unsafeWrite mv 10 (toJSON k)
VM.unsafeWrite mv 11 (toJSON l)
VM.unsafeWrite mv 12 (toM m)
VM.unsafeWrite mv 13 (toN n)
return mv
liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toEncoding h
, toEncoding i
, toEncoding j
, toEncoding k
, toEncoding l
, toM m
, toN n
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
toJSON = toJSON2
toEncoding = toEncoding2
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where
liftToJSON2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = Array $ V.create $ do
mv <- VM.unsafeNew 15
VM.unsafeWrite mv 0 (toJSON a)
VM.unsafeWrite mv 1 (toJSON b)
VM.unsafeWrite mv 2 (toJSON c)
VM.unsafeWrite mv 3 (toJSON d)
VM.unsafeWrite mv 4 (toJSON e)
VM.unsafeWrite mv 5 (toJSON f)
VM.unsafeWrite mv 6 (toJSON g)
VM.unsafeWrite mv 7 (toJSON h)
VM.unsafeWrite mv 8 (toJSON i)
VM.unsafeWrite mv 9 (toJSON j)
VM.unsafeWrite mv 10 (toJSON k)
VM.unsafeWrite mv 11 (toJSON l)
VM.unsafeWrite mv 12 (toJSON m)
VM.unsafeWrite mv 13 (toN n)
VM.unsafeWrite mv 14 (toO o)
return mv
liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id
[ toEncoding a
, toEncoding b
, toEncoding c
, toEncoding d
, toEncoding e
, toEncoding f
, toEncoding g
, toEncoding h
, toEncoding i
, toEncoding j
, toEncoding k
, toEncoding l
, toEncoding m
, toN n
, toO o
]
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where
liftToJSON = liftToJSON2 toJSON toJSONList
liftToEncoding = liftToEncoding2 toEncoding toEncodingList
instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n, ToJSON o) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
toJSON = toJSON2
toEncoding = toEncoding2
lazyToStrictByteString :: L.ByteString -> S.ByteString
#if MIN_VERSION_bytestring(0,10,0)
lazyToStrictByteString = L.toStrict
#else
lazyToStrictByteString = packChunks
packChunks :: L.ByteString -> S.ByteString
packChunks lbs =
S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
where
copyChunks L.Empty _pf = return ()
copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf = do
withForeignPtr fpbuf $ \pbuf ->
copyBytes pf (pbuf `plusPtr` o) l
copyChunks lbs' (pf `plusPtr` l)
#endif
class Monoid pairs => FromPairs enc pairs | enc -> pairs where
fromPairs :: pairs -> enc
instance FromPairs Encoding Series where
fromPairs = E.pairs
instance FromPairs Value (DList Pair) where
fromPairs = object . toList
class Monoid kv => GKeyValue v kv where
gPair :: String -> v -> kv
instance ToJSON v => GKeyValue v (DList Pair) where
gPair k v = DList.singleton (pack k .= v)
instance GKeyValue Encoding Series where
gPair = E.pairStr