{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Aeson.Types.ToJSON
    (
    -- * Core JSON classes
      ToJSON(..)
    -- * Liftings to unary and binary type constructors
    , ToJSON1(..)
    , toJSON1
    , toEncoding1
    , omitField1
    , ToJSON2(..)
    , toJSON2
    , toEncoding2
    , omitField2
    -- * Generic JSON classes
    , GToJSON'(..)
    , ToArgs(..)
    , genericToJSON
    , genericToEncoding
    , genericLiftToJSON
    , genericLiftToEncoding
    -- * Classes and types for map keys
    , ToJSONKey(..)
    , ToJSONKeyFunction(..)
    , toJSONKeyText
    , toJSONKeyKey
    , contramapToJSONKeyFunction

    , GToJSONKey()
    , genericToJSONKey

    -- * Object key-value pairs
    , KeyValue(..)
    , KeyValueOmit(..)
    , KeyValuePair(..)
    , FromPairs(..)
    -- * Functions needed for documentation
    -- * Encoding functions
    , listEncoding
    , listValue
    ) where

import Data.Aeson.Internal.Prelude

import Control.Monad.ST (ST)
import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_)
import Data.Aeson.Encoding.Internal ((>*<))
import Data.Aeson.Internal.Functions (mapKeyVal, mapKeyValO)
import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize)
import Data.Aeson.Types.Internal
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import Data.Bits (unsafeShiftR)
import Data.DList (DList)
import Data.Fixed (Fixed, HasResolution, Nano)
import Data.Foldable (toList)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Contravariant (Contravariant (..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Product (Product(..))
import Data.Functor.Sum (Sum(..))
import Data.Functor.These (These1 (..))
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (isNothing)
import Data.Ord (Down (..))
import Data.Ratio (Ratio, denominator, numerator)
import Data.Tagged (Tagged(..))
import Data.These (These (..))
import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, ZonedTime)
import Data.Time.Calendar.Month.Compat (Month)
import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..))
import Data.Time.Calendar.Compat (CalendarDiffDays (..), DayOfWeek (..))
import Data.Time.LocalTime.Compat (CalendarDiffTime (..))
import Data.Time.Clock.System.Compat (SystemTime (..))
import Data.Time.Format.Compat (FormatTime, formatTime, defaultTimeLocale)
import Data.Tuple.Solo (Solo (..), getSolo)
import Data.Version (Version, showVersion)
import Foreign.Storable (Storable)
import Foreign.C.Types (CTime (..))
import GHC.Generics
import qualified Data.Aeson.Encoding as E
import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding, key)
import qualified Data.ByteString.Lazy as L
import qualified Data.DList as DList
import qualified Data.DList.DNonEmpty as DNE
import qualified Data.Fix as F
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.Strict as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Short as ST
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 Network.URI as URI

import qualified Data.Aeson.Encoding.Builder as EB
import qualified Data.ByteString.Builder as B

import qualified GHC.Exts as Exts
import qualified Data.Primitive.Array as PM
import qualified Data.Primitive.SmallArray as PM
import qualified Data.Primitive.Types as PM
import qualified Data.Primitive.PrimArray as PM

toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
toJSONPair :: forall a b. (a -> Value) -> (b -> Value) -> (a, b) -> Value
toJSONPair a -> Value
a b -> Value
b = (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> (a, b)
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> (a, b)
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2 (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False) a -> Value
a ((a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
a) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False) b -> Value
b ((b -> Value) -> [b] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue b -> Value
b)

realFloatToJSON :: RealFloat a => a -> Value
realFloatToJSON :: forall a. RealFloat a => a -> Value
realFloatToJSON a
d
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
d      = Value
Null
    | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
d = if a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then Value
"+inf" else Value
"-inf"
    | Bool
otherwise    = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ a -> Scientific
forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits a
d

-------------------------------------------------------------------------------
-- Generics
-------------------------------------------------------------------------------

-- | Class of generic representation types that can be converted to
-- JSON.
class GToJSON' enc arity f where
    -- | This method (applied to 'defaultOptions') is used as the
    -- default generic implementation of 'toJSON'
    -- (with @enc ~ 'Value'@ and @arity ~ 'Zero'@)
    -- and 'liftToJSON' (if the @arity@ is 'One').
    --
    -- It also provides a generic implementation of 'toEncoding'
    -- (with @enc ~ 'Encoding'@ and @arity ~ 'Zero'@)
    -- and 'liftToEncoding' (if the @arity@ is 'One').
    gToJSON :: Options -> ToArgs enc arity a -> f a -> enc

-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the three
-- function arguments that encode occurrences of the type parameter (for
-- 'ToJSON1').
data ToArgs res arity a where
    NoToArgs :: ToArgs res Zero a
    To1Args  :: (a -> Bool) -> (a -> res) -> ([a] -> res) -> ToArgs res One a

-- | A configurable generic JSON creator. This function applied to
-- 'defaultOptions' is used as the default for 'toJSON' when the type
-- is an instance of 'Generic'.
genericToJSON :: (Generic a, GToJSON' Value Zero (Rep a))
              => Options -> a -> Value
genericToJSON :: forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
opts = Options -> ToArgs Value Zero Any -> Rep a Any -> Value
forall a. Options -> ToArgs Value Zero a -> Rep a a -> Value
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Value Zero Any
forall res a. ToArgs res Zero a
NoToArgs (Rep a Any -> Value) -> (a -> Rep a Any) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

-- | A configurable generic JSON creator. This function applied to
-- 'defaultOptions' is used as the default for 'liftToJSON' when the type
-- is an instance of 'Generic1'.
genericLiftToJSON :: (Generic1 f, GToJSON' Value One (Rep1 f))
                  => Options -> (a -> Bool) -> (a -> Value) -> ([a] -> Value)
                  -> f a -> Value
genericLiftToJSON :: forall (f :: * -> *) a.
(Generic1 f, GToJSON' Value One (Rep1 f)) =>
Options
-> (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
genericLiftToJSON Options
opts a -> Bool
o a -> Value
tj [a] -> Value
tjl = Options -> ToArgs Value One a -> Rep1 f a -> Value
forall a. Options -> ToArgs Value One a -> Rep1 f a -> Value
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ((a -> Bool) -> (a -> Value) -> ([a] -> Value) -> ToArgs Value One a
forall a res.
(a -> Bool) -> (a -> res) -> ([a] -> res) -> ToArgs res One a
To1Args a -> Bool
o a -> Value
tj [a] -> Value
tjl) (Rep1 f a -> Value) -> (f a -> Rep1 f a) -> f a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

-- | A configurable generic JSON encoder. This function applied to
-- 'defaultOptions' is used as the default for 'toEncoding' when the type
-- is an instance of 'Generic'.
genericToEncoding :: (Generic a, GToJSON' Encoding Zero (Rep a))
                  => Options -> a -> Encoding
genericToEncoding :: forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
opts = Options -> ToArgs Encoding Zero Any -> Rep a Any -> Encoding
forall a. Options -> ToArgs Encoding Zero a -> Rep a a -> Encoding
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Encoding Zero Any
forall res a. ToArgs res Zero a
NoToArgs (Rep a Any -> Encoding) -> (a -> Rep a Any) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

-- | A configurable generic JSON encoder. This function applied to
-- 'defaultOptions' is used as the default for 'liftToEncoding' when the type
-- is an instance of 'Generic1'.
genericLiftToEncoding :: (Generic1 f, GToJSON' Encoding One (Rep1 f))
                      => Options -> (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding)
                      -> f a -> Encoding
genericLiftToEncoding :: forall (f :: * -> *) a.
(Generic1 f, GToJSON' Encoding One (Rep1 f)) =>
Options
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> f a
-> Encoding
genericLiftToEncoding Options
opts a -> Bool
o a -> Encoding
te [a] -> Encoding
tel = Options -> ToArgs Encoding One a -> Rep1 f a -> Encoding
forall a. Options -> ToArgs Encoding One a -> Rep1 f a -> Encoding
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ((a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> ToArgs Encoding One a
forall a res.
(a -> Bool) -> (a -> res) -> ([a] -> res) -> ToArgs res One a
To1Args a -> Bool
o a -> Encoding
te [a] -> Encoding
tel) (Rep1 f a -> Encoding) -> (f a -> Rep1 f a) -> f a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall a. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------

-- | A type that can be converted to JSON.
--
-- Instances in general /must/ specify 'toJSON' and /should/ (but don't need
-- to) specify 'toEncoding'.
--
-- An example type and instance:
--
-- @
-- \-- Allow ourselves to write 'Text' literals.
-- {-\# LANGUAGE OverloadedStrings #-}
--
-- data Coord = Coord { x :: Double, y :: Double }
--
-- instance 'ToJSON' Coord where
--   'toJSON' (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]
--
--   'toEncoding' (Coord x y) = 'pairs' (\"x\" '.=' x '<>' \"y\" '.=' y)
-- @
--
-- Instead of manually writing your 'ToJSON' instance, there are two options
-- to do it automatically:
--
-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
-- instance at compile time. The generated instance is optimized for your type
-- so it will probably be more efficient than the following option.
--
-- * The compiler can provide a default generic implementation for
-- 'toJSON'.
--
-- To use the second, simply add a @deriving 'Generic'@ clause to your
-- datatype and declare a 'ToJSON' instance. If you require nothing other than
-- 'defaultOptions', it is sufficient to write (and this is the only
-- alternative where the default 'toJSON' implementation is sufficient):
--
-- @
-- {-\# LANGUAGE DeriveGeneric \#-}
--
-- import "GHC.Generics"
--
-- data Coord = Coord { x :: Double, y :: Double } deriving 'Generic'
--
-- instance 'ToJSON' Coord where
--     'toEncoding' = 'genericToEncoding' 'defaultOptions'
-- @
--
-- or more conveniently using the [DerivingVia extension](https://downloads.haskell.org/ghc/9.2.3/docs/html/users_guide/exts/deriving_via.html)
--
-- @
-- deriving via 'Generically' Coord instance 'ToJSON' Coord
-- @
--
-- If on the other hand you wish to customize the generic decoding, you have
-- to implement both methods:
--
-- @
-- customOptions = 'defaultOptions'
--                 { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
--                 }
--
-- instance 'ToJSON' Coord where
--     'toJSON'     = 'genericToJSON' customOptions
--     'toEncoding' = 'genericToEncoding' customOptions
-- @
--
-- Previous versions of this library only had the 'toJSON' method. Adding
-- 'toEncoding' had two reasons:
--
-- 1. 'toEncoding' is more efficient for the common case that the output of
-- 'toJSON' is directly serialized to a @ByteString@.
-- Further, expressing either method in terms of the other would be
-- non-optimal.
--
-- 2. The choice of defaults allows a smooth transition for existing users:
-- Existing instances that do not define 'toEncoding' still
-- compile and have the correct semantics. This is ensured by making
-- the default implementation of 'toEncoding' use 'toJSON'. This produces
-- correct results, but since it performs an intermediate conversion to a
-- 'Value', it will be less efficient than directly emitting an 'Encoding'.
-- (this also means that specifying nothing more than
-- @instance ToJSON Coord@ would be sufficient as a generically decoding
-- instance, but there probably exists no good reason to not specify
-- 'toEncoding' in new instances.)
class ToJSON a where
    -- | Convert a Haskell value to a JSON-friendly intermediate type.
    toJSON     :: a -> Value

    default toJSON :: (Generic a, GToJSON' Value Zero (Rep a)) => a -> Value
    toJSON = Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions

    -- | Encode a Haskell value as JSON.
    --
    -- The default implementation of this method creates an
    -- intermediate 'Value' using 'toJSON'.  This provides
    -- source-level compatibility for people upgrading from older
    -- versions of this library, but obviously offers no performance
    -- advantage.
    --
    -- To benefit from direct encoding, you /must/ provide an
    -- implementation for this method.  The easiest way to do so is by
    -- having your types implement 'Generic' using the @DeriveGeneric@
    -- extension, and then have GHC generate a method body as follows.
    --
    -- @
    -- instance 'ToJSON' Coord where
    --     'toEncoding' = 'genericToEncoding' 'defaultOptions'
    -- @
    toEncoding :: a -> Encoding
    toEncoding = Value -> Encoding
E.value (Value -> Encoding) -> (a -> Value) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON

    toJSONList :: [a] -> Value
    toJSONList = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
forall a. ToJSON a => a -> Value
toJSON

    toEncodingList :: [a] -> Encoding
    toEncodingList = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding

    -- | Defines when it is acceptable to omit a field of this type from a record.
    -- Used by @('.?=')@ operator, and Generics and TH deriving
    -- with @'omitNothingFields' = True@.
    --
    -- @since 2.2.0.0
    omitField :: a -> Bool
    omitField = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False

-- | @since 2.1.0.0
instance (Generic a, GToJSON' Value Zero (Rep a), GToJSON' Encoding Zero (Rep a)) => ToJSON (Generically a) where
    toJSON :: Generically a -> Value
toJSON     = (a -> Value) -> Generically a -> Value
forall a b. Coercible a b => a -> b
coerce (Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     Options
defaultOptions :: a -> Value)
    toEncoding :: Generically a -> Encoding
toEncoding = (a -> Encoding) -> Generically a -> Encoding
forall a b. Coercible a b => a -> b
coerce (Options -> a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions :: a -> Encoding)

-------------------------------------------------------------------------------
-- Object key-value pairs
-------------------------------------------------------------------------------

-- | A key-value pair for encoding a JSON object.
class KeyValue e kv | kv -> e where

    (.=) :: ToJSON v => Key -> v -> kv
    infixr 8 .=

    -- | @since 2.2.0.0
    explicitToField :: (v -> e) -> Key -> v -> kv

instance KeyValue Encoding Series where
    .= :: forall v. ToJSON v => Key -> v -> Series
(.=) = (v -> Encoding) -> Key -> v -> Series
forall v. (v -> Encoding) -> Key -> v -> Series
forall e kv v. KeyValue e kv => (v -> e) -> Key -> v -> kv
explicitToField v -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    {-# INLINE (.=) #-}

    explicitToField :: forall v. (v -> Encoding) -> Key -> v -> Series
explicitToField v -> Encoding
f Key
name v
value = Key -> Encoding -> Series
E.pair Key
name (v -> Encoding
f v
value)
    {-# INLINE explicitToField #-}

instance (key ~ Key, value ~ Value) => KeyValue Value (key, value) where
    .= :: forall v. ToJSON v => Key -> v -> (key, value)
(.=) = (v -> Value) -> Key -> v -> (key, value)
forall v. (v -> Value) -> Key -> v -> (key, value)
forall e kv v. KeyValue e kv => (v -> e) -> Key -> v -> kv
explicitToField v -> Value
forall a. ToJSON a => a -> Value
toJSON
    {-# INLINE (.=) #-}

    explicitToField :: forall v. (v -> Value) -> Key -> v -> (key, value)
explicitToField v -> Value
f Key
name v
value = (key
Key
name, v -> Value
f v
value)
    {-# INLINE explicitToField #-}

-- | Constructs a singleton 'KM.KeyMap'. For calling functions that
--   demand an 'Object' for constructing objects. To be used in
--   conjunction with 'mconcat'. Prefer to use 'object' where possible.
instance value ~ Value => KeyValue Value (KM.KeyMap value) where
    .= :: forall v. ToJSON v => Key -> v -> KeyMap value
(.=) = (v -> Value) -> Key -> v -> KeyMap value
forall v. (v -> Value) -> Key -> v -> KeyMap value
forall e kv v. KeyValue e kv => (v -> e) -> Key -> v -> kv
explicitToField v -> Value
forall a. ToJSON a => a -> Value
toJSON
    {-# INLINE (.=) #-}
    
    explicitToField :: forall v. (v -> Value) -> Key -> v -> KeyMap value
explicitToField v -> Value
f Key
name v
value = Key -> value -> KeyMap value
forall v. Key -> v -> KeyMap v
KM.singleton Key
name (v -> Value
f v
value)
    {-# INLINE explicitToField #-}

-- | An optional key-value pair for envoding to a JSON object
--
-- @since 2.2.0.0
--
class KeyValue e kv => KeyValueOmit e kv | kv -> e where
    (.?=) :: ToJSON v => Key -> v -> kv
    infixr 8 .?=

    explicitToFieldOmit :: (v -> Bool) -> (v -> e) -> Key -> v -> kv

instance KeyValueOmit Encoding Series where
    Key
name .?= :: forall v. ToJSON v => Key -> v -> Series
.?= v
value = if v -> Bool
forall a. ToJSON a => a -> Bool
omitField v
value then Series
forall a. Monoid a => a
mempty else Key
name Key -> v -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
value
    {-# INLINE (.?=) #-}

    explicitToFieldOmit :: forall v. (v -> Bool) -> (v -> Encoding) -> Key -> v -> Series
explicitToFieldOmit v -> Bool
o v -> Encoding
f Key
name v
value = if v -> Bool
o v
value then Series
forall a. Monoid a => a
mempty else (v -> Encoding) -> Key -> v -> Series
forall v. (v -> Encoding) -> Key -> v -> Series
forall e kv v. KeyValue e kv => (v -> e) -> Key -> v -> kv
explicitToField v -> Encoding
f Key
name v
value
    {-# INLINE explicitToFieldOmit #-}

instance value ~ Value => KeyValueOmit Value (KM.KeyMap value) where
    Key
name .?= :: forall v. ToJSON v => Key -> v -> KeyMap value
.?= v
value = if v -> Bool
forall a. ToJSON a => a -> Bool
omitField v
value then KeyMap value
forall v. KeyMap v
KM.empty else Key
name Key -> v -> KeyMap value
forall v. ToJSON v => Key -> v -> KeyMap value
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
value
    {-# INLINE (.?=) #-}

    explicitToFieldOmit :: forall v. (v -> Bool) -> (v -> Value) -> Key -> v -> KeyMap value
explicitToFieldOmit v -> Bool
o v -> Value
f Key
name v
value = if v -> Bool
o v
value then KeyMap value
forall v. KeyMap v
KM.empty else (v -> Value) -> Key -> v -> KeyMap value
forall v. (v -> Value) -> Key -> v -> KeyMap value
forall e kv v. KeyValue e kv => (v -> e) -> Key -> v -> kv
explicitToField v -> Value
f Key
name v
value
    {-# INLINE explicitToFieldOmit #-}

-------------------------------------------------------------------------------
--  Classes and types for map keys
-------------------------------------------------------------------------------

-- | Typeclass for types that can be used as the key of a map-like container
--   (like 'Map' or 'HashMap'). For example, since 'Text' has a 'ToJSONKey'
--   instance and 'Char' has a 'ToJSON' instance, we can encode a value of
--   type 'Map' 'Text' 'Char':
--
--   >>> LBC8.putStrLn $ encode $ Map.fromList [("foo" :: Text, 'a')]
--   {"foo":"a"}
--
--   Since 'Int' also has a 'ToJSONKey' instance, we can similarly write:
--
--   >>> LBC8.putStrLn $ encode $ Map.fromList [(5 :: Int, 'a')]
--   {"5":"a"}
--
--   JSON documents only accept strings as object keys. For any type
--   from @base@ that has a natural textual representation, it can be
--   expected that its 'ToJSONKey' instance will choose that representation.
--
--   For data types that lack a natural textual representation, an alternative
--   is provided. The map-like container is represented as a JSON array
--   instead of a JSON object. Each value in the array is an array with
--   exactly two values. The first is the key and the second is the value.
--
--   For example, values of type '[Text]' cannot be encoded to a
--   string, so a 'Map' with keys of type '[Text]' is encoded as follows:
--
--   >>> LBC8.putStrLn $ encode $ Map.fromList [(["foo","bar","baz" :: Text], 'a')]
--   [[["foo","bar","baz"],"a"]]
--
--   The default implementation of 'ToJSONKey' chooses this method of
--   encoding a key, using the 'ToJSON' instance of the type.
--
--   To use your own data type as the key in a map, all that is needed
--   is to write a 'ToJSONKey' (and possibly a 'FromJSONKey') instance
--   for it. If the type cannot be trivially converted to and from 'Text',
--   it is recommended that 'ToJSONKeyValue' is used. Since the default
--   implementations of the typeclass methods can build this from a
--   'ToJSON' instance, there is nothing that needs to be written:
--
--   > data Foo = Foo { fooAge :: Int, fooName :: Text }
--   >   deriving (Eq,Ord,Generic)
--   > instance ToJSON Foo
--   > instance ToJSONKey Foo
--
--   That's it. We can now write:
--
--   >>> let m = Map.fromList [(Foo 4 "bar",'a'),(Foo 6 "arg",'b')]
--   >>> LBC8.putStrLn $ encode m
--   [[{"fooName":"bar","fooAge":4},"a"],[{"fooName":"arg","fooAge":6},"b"]]
--
--   The next case to consider is if we have a type that is a
--   newtype wrapper around 'Text'. The recommended approach is to use
--   generalized newtype deriving:
--
--   > newtype RecordId = RecordId { getRecordId :: Text }
--   >   deriving (Eq,Ord,ToJSONKey)
--
--   Then we may write:
--
--   >>> LBC8.putStrLn $ encode $ Map.fromList [(RecordId "abc",'a')]
--   {"abc":"a"}
--
--   Simple sum types are a final case worth considering. Suppose we have:
--
--   > data Color = Red | Green | Blue
--   >   deriving (Show,Read,Eq,Ord)
--
--   It is possible to get the 'ToJSONKey' instance for free as we did
--   with 'Foo'. However, in this case, we have a natural way to go to
--   and from 'Text' that does not require any escape sequences. So
--   'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps
--   as objects instead of arrays of pairs. This instance may be
--   implemented using generics as follows:
--
-- @
-- instance 'ToJSONKey' Color where
--   'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
-- @
--
--   === __Low-level implementations__
--
--   The 'Show' instance can be used to help write 'ToJSONKey':
--
--   > instance ToJSONKey Color where
--   >   toJSONKey = ToJSONKeyText f g
--   >     where f = Text.pack . show
--   >           g = text . Text.pack . show
--   >           -- text function is from Data.Aeson.Encoding
--
--   The situation of needing to turning function @a -> Text@ into
--   a 'ToJSONKeyFunction' is common enough that a special combinator
--   is provided for it. The above instance can be rewritten as:
--
--   > instance ToJSONKey Color where
--   >   toJSONKey = toJSONKeyText (Text.pack . show)
--
--   The performance of the above instance can be improved by
--   not using 'String' as an intermediate step when converting to
--   'Text'. One option for improving performance would be to use
--   template haskell machinery from the @text-show@ package. However,
--   even with the approach, the 'Encoding' (a wrapper around a bytestring
--   builder) is generated by encoding the 'Text' to a 'ByteString',
--   an intermediate step that could be avoided. The fastest possible
--   implementation would be:
--
--   > -- Assuming that OverloadedStrings is enabled
--   > instance ToJSONKey Color where
--   >   toJSONKey = ToJSONKeyText f g
--   >     where f x = case x of {Red -> "Red";Green ->"Green";Blue -> "Blue"}
--   >           g x = case x of {Red -> text "Red";Green -> text "Green";Blue -> text "Blue"}
--   >           -- text function is from Data.Aeson.Encoding
--
--   This works because GHC can lift the encoded values out of the case
--   statements, which means that they are only evaluated once. This
--   approach should only be used when there is a serious need to
--   maximize performance.

class ToJSONKey a where
    -- | Strategy for rendering the key for a map-like container.
    toJSONKey :: ToJSONKeyFunction a
    default toJSONKey :: ToJSON a => ToJSONKeyFunction a
    toJSONKey = (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue a -> Value
forall a. ToJSON a => a -> Value
toJSON a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding

    -- | This is similar in spirit to the 'showsList' method of 'Show'.
    --   It makes it possible to give 'String' keys special treatment
    --   without using @OverlappingInstances@. End users should always
    --   be able to use the default implementation of this method.
    toJSONKeyList :: ToJSONKeyFunction [a]
    default toJSONKeyList :: ToJSON a => ToJSONKeyFunction [a]
    toJSONKeyList = ([a] -> Value) -> ([a] -> Encoding) -> ToJSONKeyFunction [a]
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue [a] -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding

data ToJSONKeyFunction a
    = ToJSONKeyText !(a -> Key) !(a -> Encoding' Key)
      -- ^ key is encoded to string, produces object
    | ToJSONKeyValue !(a -> Value) !(a -> Encoding)
      -- ^ key is encoded to value, produces array

-- | Helper for creating textual keys.
--
-- @
-- instance 'ToJSONKey' MyKey where
--     'toJSONKey' = 'toJSONKeyText' myKeyToText
--       where
--         myKeyToText = Text.pack . show -- or showt from text-show
-- @
toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText :: forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText a -> Text
f = (a -> Key) -> ToJSONKeyFunction a
forall a. (a -> Key) -> ToJSONKeyFunction a
toJSONKeyKey (Text -> Key
Key.fromText (Text -> Key) -> (a -> Text) -> a -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f)

-- |
--
-- @since 2.0.0.0
toJSONKeyKey :: (a -> Key) -> ToJSONKeyFunction a
toJSONKeyKey :: forall a. (a -> Key) -> ToJSONKeyFunction a
toJSONKeyKey a -> Key
f = (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText a -> Key
f (Key -> Encoding' Key
forall a. Key -> Encoding' a
E.key (Key -> Encoding' Key) -> (a -> Key) -> a -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Key
f)

-- | TODO: should this be exported?
toJSONKeyTextEnc :: (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc :: forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc a -> Encoding' Key
e = (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText a -> Key
tot a -> Encoding' Key
e
 where
    -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
    tot :: a -> Key
tot = Text -> Key
Key.fromText
        (Text -> Key) -> (a -> Text) -> a -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')
        (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1
        (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict
        (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' Key -> ByteString
forall a. Encoding' a -> ByteString
E.encodingToLazyByteString
        (Encoding' Key -> ByteString)
-> (a -> Encoding' Key) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding' Key
e

instance Contravariant ToJSONKeyFunction where
    contramap :: forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramap = (a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramapToJSONKeyFunction

-- | Contravariant map, as 'ToJSONKeyFunction' is a contravariant functor.
contramapToJSONKeyFunction :: (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
contramapToJSONKeyFunction :: forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramapToJSONKeyFunction b -> a
h ToJSONKeyFunction a
x = case ToJSONKeyFunction a
x of
    ToJSONKeyText  a -> Key
f a -> Encoding' Key
g -> (b -> Key) -> (b -> Encoding' Key) -> ToJSONKeyFunction b
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText (a -> Key
f (a -> Key) -> (b -> a) -> b -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
h) (a -> Encoding' Key
g (a -> Encoding' Key) -> (b -> a) -> b -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
h)
    ToJSONKeyValue a -> Value
f a -> Encoding
g -> (b -> Value) -> (b -> Encoding) -> ToJSONKeyFunction b
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
ToJSONKeyValue (a -> Value
f (a -> Value) -> (b -> a) -> b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
h) (a -> Encoding
g (a -> Encoding) -> (b -> a) -> b -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
h)

-- 'toJSONKey' for 'Generic' types.
-- Deriving is supported for enumeration types, i.e. the sums of nullary
-- constructors. The names of constructors will be used as keys for JSON
-- objects.
--
-- See also 'genericFromJSONKey'.
--
-- === __Example__
--
-- @
-- data Color = Red | Green | Blue
--   deriving 'Generic'
--
-- instance 'ToJSONKey' Color where
--   'toJSONKey' = 'genericToJSONKey' 'defaultJSONKeyOptions'
-- @
genericToJSONKey :: (Generic a, GToJSONKey (Rep a))
           => JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey :: forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
opts = (a -> Key) -> ToJSONKeyFunction a
forall a. (a -> Key) -> ToJSONKeyFunction a
toJSONKeyKey ([Char] -> Key
Key.fromString ([Char] -> Key) -> (a -> [Char]) -> a -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONKeyOptions -> [Char] -> [Char]
keyModifier JSONKeyOptions
opts ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> [Char]
forall a. Rep a a -> [Char]
forall {k} (f :: k -> *) (a :: k). GetConName f => f a -> [Char]
getConName (Rep a Any -> [Char]) -> (a -> Rep a Any) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from)

class    GetConName f => GToJSONKey f
instance GetConName f => GToJSONKey f

-------------------------------------------------------------------------------
-- Liftings of FromJSON and ToJSON to unary and binary type constructors
-------------------------------------------------------------------------------


-- | Lifting of the 'ToJSON' class to unary type constructors.
--
-- Instead of manually writing your 'ToJSON1' instance, there are two options
-- to do it automatically:
--
-- * "Data.Aeson.TH" provides Template Haskell functions which will derive an
-- instance at compile time. The generated instance is optimized for your type
-- so it will probably be more efficient than the following option.
--
-- * The compiler can provide a default generic implementation for
-- 'toJSON1'.
--
-- To use the second, simply add a @deriving 'Generic1'@ clause to your
-- datatype and declare a 'ToJSON1' instance for your datatype without giving
-- definitions for 'liftToJSON' or 'liftToEncoding'.
--
-- For example:
--
-- @
-- {-\# LANGUAGE DeriveGeneric \#-}
--
-- import "GHC.Generics"
--
-- data Pair a b = Pair { pairFst :: a, pairSnd :: b } deriving 'Generic1'
--
-- instance 'ToJSON' a => 'ToJSON1' (Pair a)
-- @
--
-- If the default implementation doesn't give exactly the results you want,
-- you can customize the generic encoding with only a tiny amount of
-- effort, using 'genericLiftToJSON' and 'genericLiftToEncoding' with
-- your preferred 'Options':
--
-- @
-- customOptions = 'defaultOptions'
--                 { 'fieldLabelModifier' = 'map' 'Data.Char.toUpper'
--                 }
--
-- instance 'ToJSON' a => 'ToJSON1' (Pair a) where
--     'liftToJSON'     = 'genericLiftToJSON' customOptions
--     'liftToEncoding' = 'genericLiftToEncoding' customOptions
-- @
--
-- See also 'ToJSON'.
class ToJSON1 f where
    liftToJSON :: (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value

    default liftToJSON :: (Generic1 f, GToJSON' Value One (Rep1 f))
                       => (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
    liftToJSON = Options
-> (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
(Generic1 f, GToJSON' Value One (Rep1 f)) =>
Options
-> (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
genericLiftToJSON Options
defaultOptions

    liftToJSONList :: (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
    liftToJSONList a -> Bool
o a -> Value
f [a] -> Value
g = (f a -> Value) -> [f a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue ((a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
f [a] -> Value
g)

    liftToEncoding :: (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding

    default liftToEncoding :: (Generic1 f, GToJSON' Encoding One (Rep1 f))
                           => (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding)
                           -> f a -> Encoding
    liftToEncoding = Options
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> f a
-> Encoding
forall (f :: * -> *) a.
(Generic1 f, GToJSON' Encoding One (Rep1 f)) =>
Options
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> f a
-> Encoding
genericLiftToEncoding Options
defaultOptions

    liftToEncodingList :: (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
    liftToEncodingList a -> Bool
o a -> Encoding
f [a] -> Encoding
g = (f a -> Encoding) -> [f a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding ((a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
f [a] -> Encoding
g)

    -- | @since 2.2.0.0
    liftOmitField :: (a -> Bool) -> f a -> Bool
    liftOmitField a -> Bool
_ f a
_ = Bool
False

-- | @since 2.1.0.0
instance (Generic1 f, GToJSON' Value One (Rep1 f), GToJSON' Encoding One (Rep1 f)) => ToJSON1 (Generically1 f) where
    liftToJSON :: forall a. (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Generically1 f a -> Value
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> Generically1 f a -> Value
liftToJSON = ((a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value)
-> (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> Generically1 f a
-> Value
forall a b. Coercible a b => a -> b
coerce (Options
-> (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
(Generic1 f, GToJSON' Value One (Rep1 f)) =>
Options
-> (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
genericLiftToJSON Options
defaultOptions :: (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value)

    liftToEncoding :: forall a. (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> Generically1 f a -> Encoding
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> Generically1 f a
-> Encoding
liftToEncoding = ((a -> Bool)
 -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding)
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> Generically1 f a
-> Encoding
forall a b. Coercible a b => a -> b
coerce (Options
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> f a
-> Encoding
forall (f :: * -> *) a.
(Generic1 f, GToJSON' Encoding One (Rep1 f)) =>
Options
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> f a
-> Encoding
genericLiftToEncoding Options
defaultOptions :: (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding)

-- | Lift the standard 'toJSON' function through the type constructor.
toJSON1 :: (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1 :: forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1 = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList
{-# INLINE toJSON1 #-}

-- | Lift the standard 'toEncoding' function through the type constructor.
toEncoding1 :: (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1 :: forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1 = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList
{-# INLINE toEncoding1 #-}

omitField1 :: (ToJSON1 f, ToJSON a) => f a -> Bool
omitField1 :: forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Bool
omitField1 = (a -> Bool) -> f a -> Bool
forall a. (a -> Bool) -> f a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
forall a. ToJSON a => a -> Bool
omitField

-- | Lifting of the 'ToJSON' class to binary type constructors.
--
-- Instead of manually writing your 'ToJSON2' instance, "Data.Aeson.TH"
-- provides Template Haskell functions which will derive an instance at compile time.
--
-- The compiler cannot provide a default generic implementation for 'liftToJSON2',
-- unlike 'toJSON' and 'liftToJSON'.
class ToJSON2 f where
    liftToJSON2 :: (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> (b -> Bool) -> (b -> Value) -> ([b] -> Value) -> f a b -> Value
    liftToJSONList2 ::  (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> (b -> Bool) -> (b -> Value) -> ([b] -> Value) -> [f a b] -> Value
    liftToJSONList2 a -> Bool
oa a -> Value
fa [a] -> Value
ga b -> Bool
ob b -> Value
fb [b] -> Value
gb = (f a b -> Value) -> [f a b] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue ((a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2 a -> Bool
oa a -> Value
fa [a] -> Value
ga b -> Bool
ob b -> Value
fb [b] -> Value
gb)

    liftToEncoding2 ::  (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> (b -> Bool) -> (b -> Encoding) -> ([b] -> Encoding) -> f a b -> Encoding
    liftToEncodingList2 ::  (a -> Bool) -> (a -> Encoding) -> ([a] -> Encoding) -> (b -> Bool) -> (b -> Encoding) -> ([b] -> Encoding) -> [f a b] -> Encoding
    liftToEncodingList2 a -> Bool
oa a -> Encoding
fa [a] -> Encoding
ga b -> Bool
ob b -> Encoding
fb [b] -> Encoding
gb = (f a b -> Encoding) -> [f a b] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding ((a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
liftToEncoding2 a -> Bool
oa a -> Encoding
fa [a] -> Encoding
ga b -> Bool
ob b -> Encoding
fb [b] -> Encoding
gb)

    -- | @since 2.2.0.0
    liftOmitField2 :: (a -> Bool) -> (b -> Bool) -> f a b -> Bool
    liftOmitField2 a -> Bool
_ b -> Bool
_ f a b
_ = Bool
False

-- | Lift the standard 'toJSON' function through the type constructor.
toJSON2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Value
toJSON2 :: forall (f :: * -> * -> *) a b.
(ToJSON2 f, ToJSON a, ToJSON b) =>
f a b -> Value
toJSON2 = (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2 a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList b -> Bool
forall a. ToJSON a => a -> Bool
omitField b -> Value
forall a. ToJSON a => a -> Value
toJSON [b] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList
{-# INLINE toJSON2 #-}

-- | Lift the standard 'toEncoding' function through the type constructor.
toEncoding2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Encoding
toEncoding2 :: forall (f :: * -> * -> *) a b.
(ToJSON2 f, ToJSON a, ToJSON b) =>
f a b -> Encoding
toEncoding2 = (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
liftToEncoding2 a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList b -> Bool
forall a. ToJSON a => a -> Bool
omitField b -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [b] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList
{-# INLINE toEncoding2 #-}

omitField2 :: (ToJSON2 f, ToJSON a, ToJSON b) => f a b -> Bool
omitField2 :: forall (f :: * -> * -> *) a b.
(ToJSON2 f, ToJSON a, ToJSON b) =>
f a b -> Bool
omitField2 = (a -> Bool) -> (b -> Bool) -> f a b -> Bool
forall a b. (a -> Bool) -> (b -> Bool) -> f a b -> Bool
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool) -> (b -> Bool) -> f a b -> Bool
liftOmitField2 a -> Bool
forall a. ToJSON a => a -> Bool
omitField b -> Bool
forall a. ToJSON a => a -> Bool
omitField
{-# INLINE omitField2 #-}

-------------------------------------------------------------------------------
-- Encoding functions
-------------------------------------------------------------------------------

-- | Helper function to use with 'liftToEncoding'.
-- Useful when writing own 'ToJSON1' instances.
--
-- @
-- newtype F a = F [a]
--
-- -- This instance encodes 'String' as an array of chars
-- instance 'ToJSON1' F where
--     'liftToJSON'     tj _ (F xs) = 'liftToJSON'     tj ('listValue'    tj) xs
--     'liftToEncoding' te _ (F xs) = 'liftToEncoding' te ('listEncoding' te) xs
--
-- instance 'Data.Aeson.FromJSON.FromJSON1' F where
--     'Data.Aeson.FromJSON.liftParseJSON' p _ v = F \<$\> 'Data.Aeson.FromJSON.liftParseJSON' p ('Data.Aeson.FromJSON.listParser' p) v
-- @
listEncoding :: (a -> Encoding) -> [a] -> Encoding
listEncoding :: forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
E.list
{-# INLINE listEncoding #-}

-- | Helper function to use with 'liftToJSON', see 'listEncoding'.
listValue :: (a -> Value) -> [a] -> Value
listValue :: forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
f = Array -> Value
Array (Array -> Value) -> ([a] -> Array) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> ([a] -> [Value]) -> [a] -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
f
{-# INLINE listValue #-}

-------------------------------------------------------------------------------
-- [] instances
-------------------------------------------------------------------------------

-- These are needed for key-class default definitions

instance ToJSON1 [] where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [a] -> Value
liftToJSON a -> Bool
_ a -> Value
_ [a] -> Value
to' = [a] -> Value
to'

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [a] -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
_ [a] -> Encoding
to' = [a] -> Encoding
to'

instance (ToJSON a) => ToJSON [a] where
    {-# SPECIALIZE instance ToJSON String #-}
    {-# SPECIALIZE instance ToJSON [String] #-}
    {-# SPECIALIZE instance ToJSON [Array] #-}
    {-# SPECIALIZE instance ToJSON [Object] #-}

    toJSON :: [a] -> Value
toJSON = [a] -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1

    toEncoding :: [a] -> Encoding
toEncoding = [a] -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-------------------------------------------------------------------------------
-- Generic toJSON / toEncoding
-------------------------------------------------------------------------------

instance {-# OVERLAPPABLE #-} (GToJSON' enc arity a) => GToJSON' enc arity (M1 i c a) where
    -- Meta-information, which is not handled elsewhere, is ignored:
    gToJSON :: forall a. Options -> ToArgs enc arity a -> M1 i c a a -> enc
gToJSON Options
opts ToArgs enc arity a
targs = Options -> ToArgs enc arity a -> a a -> enc
forall a. Options -> ToArgs enc arity a -> a a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs (a a -> enc) -> (M1 i c a a -> a a) -> M1 i c a a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINE gToJSON #-}

instance GToJSON' enc One Par1 where
    -- Direct occurrences of the last type parameter are encoded with the
    -- function passed in as an argument:
    gToJSON :: forall a. Options -> ToArgs enc One a -> Par1 a -> enc
gToJSON Options
_opts (To1Args a -> Bool
_ a -> enc
tj [a] -> enc
_) = a -> enc
tj (a -> enc) -> (Par1 a -> a) -> Par1 a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Par1 a -> a
forall p. Par1 p -> p
unPar1 -- TODO
    {-# INLINE gToJSON #-}

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
    -- The option 'tagSingleConstructors' determines whether to wrap
    -- a single-constructor type.
    gToJSON :: forall a. Options -> ToArgs enc arity a -> D1 d (C1 c a) a -> enc
gToJSON Options
opts ToArgs enc arity a
targs
        | Options -> Bool
tagSingleConstructors Options
opts = (Tagged allNullary enc -> enc
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged allNullary enc -> enc)
                                     (Tagged allNullary enc -> enc)
-> (D1 d (C1 c a) a -> Tagged allNullary enc)
-> D1 d (C1 c a) a
-> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> C1 c a a -> Tagged allNullary enc
forall a.
Options -> ToArgs enc arity a -> C1 c a a -> Tagged allNullary enc
forall {k} enc arity (f :: * -> *) (allNullary :: k) a.
SumToJSON enc arity f allNullary =>
Options -> ToArgs enc arity a -> f a -> Tagged allNullary enc
sumToJSON Options
opts ToArgs enc arity a
targs
                                     (C1 c a a -> Tagged allNullary enc)
-> (D1 d (C1 c a) a -> C1 c a a)
-> D1 d (C1 c a) a
-> Tagged allNullary enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 d (C1 c a) a -> C1 c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
        | Bool
otherwise = Options -> ToArgs enc arity a -> a a -> enc
forall a. Options -> ToArgs enc arity a -> a a -> enc
forall enc arity (f :: * -> *) a.
ConsToJSON enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
consToJSON Options
opts ToArgs enc arity a
targs (a a -> enc) -> (D1 d (C1 c a) a -> a a) -> D1 d (C1 c a) a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (C1 c a a -> a a)
-> (D1 d (C1 c a) a -> C1 c a a) -> D1 d (C1 c a) a -> a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 d (C1 c a) a -> C1 c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINE gToJSON #-}

instance (ConsToJSON enc arity a) => GToJSON' enc arity (C1 c a) where
    -- Constructors need to be encoded differently depending on whether they're
    -- a record or not. This distinction is made by 'consToJSON':
    gToJSON :: forall a. Options -> ToArgs enc arity a -> C1 c a a -> enc
gToJSON Options
opts ToArgs enc arity a
targs = Options -> ToArgs enc arity a -> a a -> enc
forall a. Options -> ToArgs enc arity a -> a a -> enc
forall enc arity (f :: * -> *) a.
ConsToJSON enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
consToJSON Options
opts ToArgs enc arity a
targs (a a -> enc) -> (C1 c a a -> a a) -> C1 c a a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINE gToJSON #-}

instance ( AllNullary       (a :+: b) allNullary
         , SumToJSON  enc arity (a :+: b) allNullary
         ) => GToJSON' enc arity (a :+: b)
  where
    -- If all constructors of a sum datatype are nullary and the
    -- 'allNullaryToStringTag' option is set they are encoded to
    -- strings.  This distinction is made by 'sumToJSON':
    gToJSON :: forall a. Options -> ToArgs enc arity a -> (:+:) a b a -> enc
gToJSON Options
opts ToArgs enc arity a
targs = (Tagged allNullary enc -> enc
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged allNullary enc -> enc)
                       (Tagged allNullary enc -> enc)
-> ((:+:) a b a -> Tagged allNullary enc) -> (:+:) a b a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options
-> ToArgs enc arity a -> (:+:) a b a -> Tagged allNullary enc
forall a.
Options
-> ToArgs enc arity a -> (:+:) a b a -> Tagged allNullary enc
forall {k} enc arity (f :: * -> *) (allNullary :: k) a.
SumToJSON enc arity f allNullary =>
Options -> ToArgs enc arity a -> f a -> Tagged allNullary enc
sumToJSON Options
opts ToArgs enc arity a
targs
    {-# INLINE gToJSON #-}

--------------------------------------------------------------------------------
-- Generic toJSON

-- Note: Refactoring 'ToJSON a' to 'ToJSON enc a' (and 'ToJSON1' similarly) is
-- possible but makes error messages a bit harder to understand for missing
-- instances.

instance GToJSON' Value arity V1 where
    -- Empty values do not exist, which makes the job of formatting them
    -- rather easy:
    gToJSON :: forall a. Options -> ToArgs Value arity a -> V1 a -> Value
gToJSON Options
_ ToArgs Value arity a
_ V1 a
x = V1 a
x V1 a -> Value -> Value
forall a b. a -> b -> b
`seq` [Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"case: V1"
    {-# INLINE gToJSON #-}

instance ToJSON a => GToJSON' Value arity (K1 i a) where
    -- Constant values are encoded using their ToJSON instance:
    gToJSON :: forall a. Options -> ToArgs Value arity a -> K1 i a a -> Value
gToJSON Options
_opts ToArgs Value arity a
_ = a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> (K1 i a a -> a) -> K1 i a a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall k i c (p :: k). K1 i c p -> c
unK1
    {-# INLINE gToJSON #-}

instance ToJSON1 f => GToJSON' Value One (Rec1 f) where
    -- Recursive occurrences of the last type parameter are encoded using their
    -- ToJSON1 instance:
    gToJSON :: forall a. Options -> ToArgs Value One a -> Rec1 f a -> Value
gToJSON Options
_opts (To1Args a -> Bool
o a -> Value
tj [a] -> Value
tjl) = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
tj [a] -> Value
tjl (f a -> Value) -> (Rec1 f a -> f a) -> Rec1 f a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
    {-# INLINE gToJSON #-}

instance GToJSON' Value arity U1 where
    -- Empty constructors are encoded to an empty array:
    gToJSON :: forall a. Options -> ToArgs Value arity a -> U1 a -> Value
gToJSON Options
_opts ToArgs Value arity a
_ U1 a
_ = Value
emptyArray
    {-# INLINE gToJSON #-}

instance ( WriteProduct arity a, WriteProduct arity b
         , ProductSize        a, ProductSize        b
         ) => GToJSON' Value arity (a :*: b)
  where
    -- Products are encoded to an array. Here we allocate a mutable vector of
    -- the same size as the product and write the product's elements to it using
    -- 'writeProduct':
    gToJSON :: forall a. Options -> ToArgs Value arity a -> (:*:) a b a -> Value
gToJSON Options
opts ToArgs Value arity a
targs (:*:) a b a
p =
        Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MVector s Value)) -> Array
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s Value)) -> Array)
-> (forall s. ST s (MVector s Value)) -> Array
forall a b. (a -> b) -> a -> b
$ do
          MVector s Value
mv <- Int -> ST s (MVector (PrimState (ST s)) Value)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.unsafeNew Int
lenProduct
          Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> (:*:) a b a
-> ST s ()
forall a s.
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> (:*:) a b a
-> ST s ()
forall arity (f :: * -> *) a s.
WriteProduct arity f =>
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> f a
-> ST s ()
writeProduct Options
opts ToArgs Value arity a
targs MVector s Value
mv Int
0 Int
lenProduct (:*:) a b a
p
          MVector s Value -> ST s (MVector s Value)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Value
mv
        where
          lenProduct :: Int
lenProduct = (Tagged2 (a :*: b) Int -> Int
forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 :: Tagged2 (a :*: b) Int -> Int)
                       Tagged2 (a :*: b) Int
forall (f :: * -> *). ProductSize f => Tagged2 f Int
productSize
    {-# INLINE gToJSON #-}

instance ( ToJSON1 f
         , GToJSON' Value One g
         ) => GToJSON' Value One (f :.: g)
  where
    -- If an occurrence of the last type parameter is nested inside two
    -- composed types, it is encoded by using the outermost type's ToJSON1
    -- instance to generically encode the innermost type:
    gToJSON :: forall a. Options -> ToArgs Value One a -> (:.:) f g a -> Value
gToJSON Options
opts ToArgs Value One a
targs =
      let gtj :: g a -> Value
gtj = Options -> ToArgs Value One a -> g a -> Value
forall a. Options -> ToArgs Value One a -> g a -> Value
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Value One a
targs in
      (g a -> Bool)
-> (g a -> Value) -> ([g a] -> Value) -> f (g a) -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON (Bool -> g a -> Bool
forall a b. a -> b -> a
const Bool
False) g a -> Value
gtj ((g a -> Value) -> [g a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue g a -> Value
gtj) (f (g a) -> Value)
-> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) f g a -> f (g a)
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1
    {-# INLINE gToJSON #-}

--------------------------------------------------------------------------------
-- Generic toEncoding

instance GToJSON' Encoding arity V1 where
    -- Empty values do not exist, which makes the job of formatting them
    -- rather easy:
    gToJSON :: forall a. Options -> ToArgs Encoding arity a -> V1 a -> Encoding
gToJSON Options
_ ToArgs Encoding arity a
_ V1 a
x = case V1 a
x of {}
    {-# INLINE gToJSON #-}

instance ToJSON a => GToJSON' Encoding arity (K1 i a) where
    -- Constant values are encoded using their ToJSON instance:
    gToJSON :: forall a.
Options -> ToArgs Encoding arity a -> K1 i a a -> Encoding
gToJSON Options
_opts ToArgs Encoding arity a
_ = a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (a -> Encoding) -> (K1 i a a -> a) -> K1 i a a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall k i c (p :: k). K1 i c p -> c
unK1
    {-# INLINE gToJSON #-}

instance ToJSON1 f => GToJSON' Encoding One (Rec1 f) where
    -- Recursive occurrences of the last type parameter are encoded using their
    -- ToEncoding1 instance:
    gToJSON :: forall a. Options -> ToArgs Encoding One a -> Rec1 f a -> Encoding
gToJSON Options
_opts (To1Args a -> Bool
o a -> Encoding
te [a] -> Encoding
tel) = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel (f a -> Encoding) -> (Rec1 f a -> f a) -> Rec1 f a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
    {-# INLINE gToJSON #-}

instance GToJSON' Encoding arity U1 where
    -- Empty constructors are encoded to an empty array:
    gToJSON :: forall a. Options -> ToArgs Encoding arity a -> U1 a -> Encoding
gToJSON Options
_opts ToArgs Encoding arity a
_ U1 a
_ = Encoding
E.emptyArray_
    {-# INLINE gToJSON #-}

instance ( EncodeProduct  arity a
         , EncodeProduct  arity b
         ) => GToJSON' Encoding arity (a :*: b)
  where
    -- Products are encoded to an array. Here we allocate a mutable vector of
    -- the same size as the product and write the product's elements to it using
    -- 'encodeProduct':
    gToJSON :: forall a.
Options -> ToArgs Encoding arity a -> (:*:) a b a -> Encoding
gToJSON Options
opts ToArgs Encoding arity a
targs (:*:) a b a
p = (Encoding' InArray -> Encoding) -> [Encoding' InArray] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
E.list Encoding' InArray -> Encoding
forall a b. Encoding' a -> Encoding' b
E.retagEncoding [Options
-> ToArgs Encoding arity a -> (:*:) a b a -> Encoding' InArray
forall a.
Options
-> ToArgs Encoding arity a -> (:*:) a b a -> Encoding' InArray
forall arity (f :: * -> *) a.
EncodeProduct arity f =>
Options -> ToArgs Encoding arity a -> f a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs (:*:) a b a
p]
    {-# INLINE gToJSON #-}

instance ( ToJSON1 f
         , GToJSON' Encoding One g
         ) => GToJSON' Encoding One (f :.: g)
  where
    -- If an occurrence of the last type parameter is nested inside two
    -- composed types, it is encoded by using the outermost type's ToJSON1
    -- instance to generically encode the innermost type:
    gToJSON :: forall a.
Options -> ToArgs Encoding One a -> (:.:) f g a -> Encoding
gToJSON Options
opts ToArgs Encoding One a
targs =
      let gte :: g a -> Encoding
gte = Options -> ToArgs Encoding One a -> g a -> Encoding
forall a. Options -> ToArgs Encoding One a -> g a -> Encoding
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Encoding One a
targs in
      (g a -> Bool)
-> (g a -> Encoding) -> ([g a] -> Encoding) -> f (g a) -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding (Bool -> g a -> Bool
forall a b. a -> b -> a
const Bool
False) g a -> Encoding
gte ((g a -> Encoding) -> [g a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding g a -> Encoding
gte) (f (g a) -> Encoding)
-> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) f g a -> f (g a)
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1
    {-# INLINE gToJSON #-}

--------------------------------------------------------------------------------

class SumToJSON enc arity f allNullary where
    sumToJSON :: Options -> ToArgs enc arity a
              -> f a -> Tagged allNullary enc

instance ( GetConName f
         , IsString 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 :: forall a. Options -> ToArgs enc arity a -> f a -> Tagged True enc
sumToJSON Options
opts ToArgs enc arity a
targs
        | Options -> Bool
allNullaryToStringTag Options
opts = enc -> Tagged True enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged True enc) -> (f a -> enc) -> f a -> Tagged True enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> enc
forall a. IsString a => [Char] -> a
fromString
                                     ([Char] -> enc) -> (f a -> [Char]) -> f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
constructorTagModifier Options
opts ([Char] -> [Char]) -> (f a -> [Char]) -> f a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [Char]
forall a. f a -> [Char]
forall {k} (f :: k -> *) (a :: k). GetConName f => f a -> [Char]
getConName
        | Bool
otherwise = enc -> Tagged True enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged True enc) -> (f a -> enc) -> f a -> Tagged True enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> enc
forall enc arity (f :: * -> *) a.
(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 Options
opts ToArgs enc arity a
targs
    {-# INLINE sumToJSON #-}

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 :: forall a. Options -> ToArgs enc arity a -> f a -> Tagged False enc
sumToJSON Options
opts ToArgs enc arity a
targs = enc -> Tagged False enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged False enc)
-> (f a -> enc) -> f a -> Tagged False enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> enc
forall enc arity (f :: * -> *) a.
(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 Options
opts ToArgs enc arity a
targs
    {-# INLINE sumToJSON #-}

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 :: forall enc arity (f :: * -> *) a.
(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 Options
opts ToArgs enc arity a
targs =
    case Options -> SumEncoding
sumEncoding Options
opts of

      TaggedObject{[Char]
tagFieldName :: [Char]
contentsFieldName :: [Char]
tagFieldName :: SumEncoding -> [Char]
contentsFieldName :: SumEncoding -> [Char]
..}      ->
        Options -> ToArgs enc arity a -> Key -> Key -> f a -> enc
forall a. Options -> ToArgs enc arity a -> Key -> Key -> f a -> enc
forall enc arity (f :: * -> *) a.
TaggedObject enc arity f =>
Options -> ToArgs enc arity a -> Key -> Key -> f a -> enc
taggedObject Options
opts ToArgs enc arity a
targs ([Char] -> Key
Key.fromString [Char]
tagFieldName) ([Char] -> Key
Key.fromString [Char]
contentsFieldName)

      SumEncoding
ObjectWithSingleField ->
        (Tagged ObjectWithSingleField enc -> enc
forall {enc}. Tagged ObjectWithSingleField enc -> enc
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged ObjectWithSingleField enc -> enc)
          (Tagged ObjectWithSingleField enc -> enc)
-> (f a -> Tagged ObjectWithSingleField enc) -> f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options
-> ToArgs enc arity a -> f a -> Tagged ObjectWithSingleField enc
forall a.
Options
-> ToArgs enc arity a -> f a -> Tagged ObjectWithSingleField enc
forall {k} (s :: k) enc arity (f :: * -> *) a.
SumToJSON' s enc arity f =>
Options -> ToArgs enc arity a -> f a -> Tagged s enc
sumToJSON' Options
opts ToArgs enc arity a
targs

      SumEncoding
TwoElemArray          ->
        (Tagged TwoElemArray enc -> enc
forall {enc}. Tagged TwoElemArray enc -> enc
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged TwoElemArray enc -> enc)
          (Tagged TwoElemArray enc -> enc)
-> (f a -> Tagged TwoElemArray enc) -> f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> Tagged TwoElemArray enc
forall a.
Options -> ToArgs enc arity a -> f a -> Tagged TwoElemArray enc
forall {k} (s :: k) enc arity (f :: * -> *) a.
SumToJSON' s enc arity f =>
Options -> ToArgs enc arity a -> f a -> Tagged s enc
sumToJSON' Options
opts ToArgs enc arity a
targs

      SumEncoding
UntaggedValue         ->
        (Tagged UntaggedValue enc -> enc
forall {enc}. Tagged UntaggedValue enc -> enc
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged UntaggedValue enc -> enc)
          (Tagged UntaggedValue enc -> enc)
-> (f a -> Tagged UntaggedValue enc) -> f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> Tagged UntaggedValue enc
forall a.
Options -> ToArgs enc arity a -> f a -> Tagged UntaggedValue enc
forall {k} (s :: k) enc arity (f :: * -> *) a.
SumToJSON' s enc arity f =>
Options -> ToArgs enc arity a -> f a -> Tagged s enc
sumToJSON' Options
opts ToArgs enc arity a
targs
{-# INLINE nonAllNullarySumToJSON #-}

--------------------------------------------------------------------------------



--------------------------------------------------------------------------------

class TaggedObject enc arity f where
    taggedObject :: Options -> ToArgs enc arity a
                 -> Key -> Key
                 -> f a -> enc

instance ( TaggedObject enc arity a
         , TaggedObject enc arity b
         ) => TaggedObject enc arity (a :+: b)
  where
    taggedObject :: forall a.
Options -> ToArgs enc arity a -> Key -> Key -> (:+:) a b a -> enc
taggedObject Options
opts ToArgs enc arity a
targs Key
tagFieldName Key
contentsFieldName (L1 a a
x) =
        Options -> ToArgs enc arity a -> Key -> Key -> a a -> enc
forall a. Options -> ToArgs enc arity a -> Key -> Key -> a a -> enc
forall enc arity (f :: * -> *) a.
TaggedObject enc arity f =>
Options -> ToArgs enc arity a -> Key -> Key -> f a -> enc
taggedObject Options
opts ToArgs enc arity a
targs Key
tagFieldName Key
contentsFieldName a a
x
    taggedObject Options
opts ToArgs enc arity a
targs Key
tagFieldName Key
contentsFieldName (R1 b a
x) =
        Options -> ToArgs enc arity a -> Key -> Key -> b a -> enc
forall a. Options -> ToArgs enc arity a -> Key -> Key -> b a -> enc
forall enc arity (f :: * -> *) a.
TaggedObject enc arity f =>
Options -> ToArgs enc arity a -> Key -> Key -> f a -> enc
taggedObject Options
opts ToArgs enc arity a
targs Key
tagFieldName Key
contentsFieldName b a
x
    {-# INLINE taggedObject #-}

instance ( IsRecord                      a isRecord
         , TaggedObject' enc pairs arity a isRecord
         , FromPairs enc pairs
         , IsString enc
         , KeyValuePair enc pairs
         , Constructor c
         ) => TaggedObject enc arity (C1 c a)
  where
    taggedObject :: forall a.
Options -> ToArgs enc arity a -> Key -> Key -> C1 c a a -> enc
taggedObject Options
opts ToArgs enc arity a
targs Key
tagFieldName Key
contentsFieldName =
      pairs -> enc
forall enc pairs. FromPairs enc pairs => pairs -> enc
fromPairs (pairs -> enc) -> (C1 c a a -> pairs) -> C1 c a a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pairs -> pairs -> pairs
forall a. Monoid a => a -> a -> a
mappend pairs
tag (pairs -> pairs) -> (C1 c a a -> pairs) -> C1 c a a -> pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c a a -> pairs
contents
      where
        tag :: pairs
tag = Key
tagFieldName Key -> enc -> pairs
forall v kv. KeyValuePair v kv => Key -> v -> kv
`pair`
          ([Char] -> enc
forall a. IsString a => [Char] -> a
fromString (Options -> [Char] -> [Char]
constructorTagModifier Options
opts (Any c a Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName (t c a p
forall {k} {t :: Meta -> (* -> *) -> k -> *} {p :: k}. t c a p
forall a. HasCallStack => a
undefined :: t c a p)))
            :: enc)
        contents :: C1 c a a -> pairs
contents =
          (Tagged isRecord pairs -> pairs
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged isRecord pairs -> pairs) (Tagged isRecord pairs -> pairs)
-> (C1 c a a -> Tagged isRecord pairs) -> C1 c a a -> pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Options
-> ToArgs enc arity a -> Key -> a a -> Tagged isRecord pairs
forall a.
Options
-> ToArgs enc arity a -> Key -> a a -> Tagged isRecord pairs
forall {k} enc pairs arity (f :: * -> *) (isRecord :: k) a.
TaggedObject' enc pairs arity f isRecord =>
Options
-> ToArgs enc arity a -> Key -> f a -> Tagged isRecord pairs
taggedObject' Options
opts ToArgs enc arity a
targs Key
contentsFieldName (a a -> Tagged isRecord pairs)
-> (C1 c a a -> a a) -> C1 c a a -> Tagged isRecord pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINE taggedObject #-}

class TaggedObject' enc pairs arity f isRecord where
    taggedObject' :: Options -> ToArgs enc arity a
                  -> Key -> f a -> Tagged isRecord pairs

instance ( GToJSON' enc arity f
         , KeyValuePair enc pairs
         ) => TaggedObject' enc pairs arity f False
  where
    taggedObject' :: forall a.
Options -> ToArgs enc arity a -> Key -> f a -> Tagged False pairs
taggedObject' Options
opts ToArgs enc arity a
targs Key
contentsFieldName =
        pairs -> Tagged False pairs
forall {k} (s :: k) b. b -> Tagged s b
Tagged (pairs -> Tagged False pairs)
-> (f a -> pairs) -> f a -> Tagged False pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
contentsFieldName Key -> enc -> pairs
forall v kv. KeyValuePair v kv => Key -> v -> kv
`pair`) (enc -> pairs) -> (f a -> enc) -> f a -> pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> enc
forall a. Options -> ToArgs enc arity a -> f a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs
    {-# INLINE taggedObject' #-}

instance {-# OVERLAPPING #-} Monoid pairs => TaggedObject' enc pairs arity U1 False where
    taggedObject' :: forall a.
Options -> ToArgs enc arity a -> Key -> U1 a -> Tagged False pairs
taggedObject' Options
_ ToArgs enc arity a
_ Key
_ U1 a
_ = pairs -> Tagged False pairs
forall {k} (s :: k) b. b -> Tagged s b
Tagged pairs
forall a. Monoid a => a
mempty
    {-# INLINE taggedObject' #-}

instance ( RecordToPairs enc pairs arity f
         ) => TaggedObject' enc pairs arity f True
  where
    taggedObject' :: forall a.
Options -> ToArgs enc arity a -> Key -> f a -> Tagged True pairs
taggedObject' Options
opts ToArgs enc arity a
targs Key
_ = pairs -> Tagged True pairs
forall {k} (s :: k) b. b -> Tagged s b
Tagged (pairs -> Tagged True pairs)
-> (f a -> pairs) -> f a -> Tagged True pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> pairs
forall a. Options -> ToArgs enc arity a -> f a -> pairs
forall enc pairs arity (f :: * -> *) a.
RecordToPairs enc pairs arity f =>
Options -> ToArgs enc arity a -> f a -> pairs
recordToPairs Options
opts ToArgs enc arity a
targs
    {-# INLINE taggedObject' #-}

--------------------------------------------------------------------------------

-- | Get the name of the constructor of a sum datatype.
class GetConName f where
    getConName :: f a -> String

instance (GetConName a, GetConName b) => GetConName (a :+: b) where
    getConName :: forall (a :: k). (:+:) a b a -> [Char]
getConName (L1 a a
x) = a a -> [Char]
forall (a :: k). a a -> [Char]
forall {k} (f :: k -> *) (a :: k). GetConName f => f a -> [Char]
getConName a a
x
    getConName (R1 b a
x) = b a -> [Char]
forall (a :: k). b a -> [Char]
forall {k} (f :: k -> *) (a :: k). GetConName f => f a -> [Char]
getConName b a
x
    {-# INLINE getConName #-}

instance (Constructor c) => GetConName (C1 c a) where
    getConName :: forall (a :: k). C1 c a a -> [Char]
getConName = M1 C c a a -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName
    {-# INLINE getConName #-}

-- For genericToJSONKey
instance GetConName a => GetConName (D1 d a) where
    getConName :: forall (a :: k). D1 d a a -> [Char]
getConName (M1 a a
x) = a a -> [Char]
forall (a :: k). a a -> [Char]
forall {k} (f :: k -> *) (a :: k). GetConName f => f a -> [Char]
getConName a a
x
    {-# INLINE getConName #-}

--------------------------------------------------------------------------------

-- Reflection of SumEncoding variants

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' :: forall a.
Options -> ToArgs enc arity a -> (:+:) a b a -> Tagged s enc
sumToJSON' Options
opts ToArgs enc arity a
targs (L1 a a
x) = Options -> ToArgs enc arity a -> a a -> Tagged s enc
forall a. Options -> ToArgs enc arity a -> a a -> Tagged s enc
forall {k} (s :: k) enc arity (f :: * -> *) a.
SumToJSON' s enc arity f =>
Options -> ToArgs enc arity a -> f a -> Tagged s enc
sumToJSON' Options
opts ToArgs enc arity a
targs a a
x
    sumToJSON' Options
opts ToArgs enc arity a
targs (R1 b a
x) = Options -> ToArgs enc arity a -> b a -> Tagged s enc
forall a. Options -> ToArgs enc arity a -> b a -> Tagged s enc
forall {k} (s :: k) enc arity (f :: * -> *) a.
SumToJSON' s enc arity f =>
Options -> ToArgs enc arity a -> f a -> Tagged s enc
sumToJSON' Options
opts ToArgs enc arity a
targs b a
x
    {-# INLINE sumToJSON' #-}

--------------------------------------------------------------------------------

instance ( GToJSON'    Value arity a
         , ConsToJSON Value arity a
         , Constructor c
         ) => SumToJSON' TwoElemArray Value arity (C1 c a) where
    sumToJSON' :: forall a.
Options
-> ToArgs Value arity a -> C1 c a a -> Tagged TwoElemArray Value
sumToJSON' Options
opts ToArgs Value arity a
targs C1 c a a
x = Value -> Tagged TwoElemArray Value
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Value -> Tagged TwoElemArray Value)
-> Value -> Tagged TwoElemArray Value
forall a b. (a -> b) -> a -> b
$ Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MVector s Value)) -> Array
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s Value)) -> Array)
-> (forall s. ST s (MVector s Value)) -> Array
forall a b. (a -> b) -> a -> b
$ do
      MVector s Value
mv <- Int -> ST s (MVector (PrimState (ST s)) Value)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.unsafeNew Int
2
      MVector (PrimState (ST s)) Value -> Int -> Value -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite MVector s Value
MVector (PrimState (ST s)) Value
mv Int
0 (Value -> ST s ()) -> Value -> ST s ()
forall a b. (a -> b) -> a -> b
$ Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Options -> [Char] -> [Char]
constructorTagModifier Options
opts
                                   ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Any c a Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName (t c a p
forall {k} {t :: Meta -> (* -> *) -> k -> *} {p :: k}. t c a p
forall a. HasCallStack => a
undefined :: t c a p)
      MVector (PrimState (ST s)) Value -> Int -> Value -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite MVector s Value
MVector (PrimState (ST s)) Value
mv Int
1 (Value -> ST s ()) -> Value -> ST s ()
forall a b. (a -> b) -> a -> b
$ Options -> ToArgs Value arity a -> C1 c a a -> Value
forall a. Options -> ToArgs Value arity a -> M1 C c a a -> Value
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Value arity a
targs C1 c a a
x
      MVector s Value -> ST s (MVector s Value)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Value
mv
    {-# INLINE sumToJSON' #-}

--------------------------------------------------------------------------------

instance ( GToJSON'    Encoding arity a
         , ConsToJSON Encoding arity a
         , Constructor c
         ) => SumToJSON' TwoElemArray Encoding arity (C1 c a)
  where
    sumToJSON' :: forall a.
Options
-> ToArgs Encoding arity a
-> C1 c a a
-> Tagged TwoElemArray Encoding
sumToJSON' Options
opts ToArgs Encoding arity a
targs C1 c a a
x = Encoding -> Tagged TwoElemArray Encoding
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Encoding -> Tagged TwoElemArray Encoding)
-> Encoding -> Tagged TwoElemArray Encoding
forall a b. (a -> b) -> a -> b
$ (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
E.list Encoding -> Encoding
forall a. a -> a
id
      [ [Char] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Options -> [Char] -> [Char]
constructorTagModifier Options
opts (Any c a Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName (t c a p
forall {k} {t :: Meta -> (* -> *) -> k -> *} {p :: k}. t c a p
forall a. HasCallStack => a
undefined :: t c a p)))
      , Options -> ToArgs Encoding arity a -> C1 c a a -> Encoding
forall a.
Options -> ToArgs Encoding arity a -> M1 C c a a -> Encoding
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Encoding arity a
targs C1 c a a
x
      ]
    {-# INLINE sumToJSON' #-}

--------------------------------------------------------------------------------

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
                    -> f a -> Tagged isRecord enc

instance ( IsRecord                f isRecord
         , ConsToJSON'   enc arity f isRecord
         ) => ConsToJSON enc arity f
  where
    consToJSON :: forall a. Options -> ToArgs enc arity a -> f a -> enc
consToJSON Options
opts ToArgs enc arity a
targs =
        (Tagged isRecord enc -> enc
forall {k} (s :: k) b. Tagged s b -> b
unTagged :: Tagged isRecord enc -> enc)
      (Tagged isRecord enc -> enc)
-> (f a -> Tagged isRecord enc) -> f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> Tagged isRecord enc
forall a.
Options -> ToArgs enc arity a -> f a -> Tagged isRecord enc
forall {k} enc arity (f :: * -> *) (isRecord :: k) a.
ConsToJSON' enc arity f isRecord =>
Options -> ToArgs enc arity a -> f a -> Tagged isRecord enc
consToJSON' Options
opts ToArgs enc arity a
targs
    {-# INLINE consToJSON #-}

instance {-# OVERLAPPING #-}
         ( RecordToPairs enc pairs arity (S1 s f)
         , FromPairs enc pairs
         , GToJSON' enc arity f
         ) => ConsToJSON' enc arity (S1 s f) True
  where
    consToJSON' :: forall a.
Options -> ToArgs enc arity a -> S1 s f a -> Tagged True enc
consToJSON' Options
opts ToArgs enc arity a
targs
      | Options -> Bool
unwrapUnaryRecords Options
opts = enc -> Tagged True enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged True enc)
-> (S1 s f a -> enc) -> S1 s f a -> Tagged True enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> S1 s f a -> enc
forall a. Options -> ToArgs enc arity a -> M1 S s f a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs
      | Bool
otherwise = enc -> Tagged True enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged True enc)
-> (S1 s f a -> enc) -> S1 s f a -> Tagged True enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pairs -> enc
forall enc pairs. FromPairs enc pairs => pairs -> enc
fromPairs (pairs -> enc) -> (S1 s f a -> pairs) -> S1 s f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> S1 s f a -> pairs
forall a. Options -> ToArgs enc arity a -> M1 S s f a -> pairs
forall enc pairs arity (f :: * -> *) a.
RecordToPairs enc pairs arity f =>
Options -> ToArgs enc arity a -> f a -> pairs
recordToPairs Options
opts ToArgs enc arity a
targs
    {-# INLINE consToJSON' #-}

instance ( RecordToPairs enc pairs arity f
         , FromPairs enc pairs
         ) => ConsToJSON' enc arity f True
  where
    consToJSON' :: forall a. Options -> ToArgs enc arity a -> f a -> Tagged True enc
consToJSON' Options
opts ToArgs enc arity a
targs = enc -> Tagged True enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged True enc) -> (f a -> enc) -> f a -> Tagged True enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pairs -> enc
forall enc pairs. FromPairs enc pairs => pairs -> enc
fromPairs (pairs -> enc) -> (f a -> pairs) -> f a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> pairs
forall a. Options -> ToArgs enc arity a -> f a -> pairs
forall enc pairs arity (f :: * -> *) a.
RecordToPairs enc pairs arity f =>
Options -> ToArgs enc arity a -> f a -> pairs
recordToPairs Options
opts ToArgs enc arity a
targs
    {-# INLINE consToJSON' #-}

instance GToJSON' enc arity f => ConsToJSON' enc arity f False where
    consToJSON' :: forall a. Options -> ToArgs enc arity a -> f a -> Tagged False enc
consToJSON' Options
opts ToArgs enc arity a
targs = enc -> Tagged False enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged False enc)
-> (f a -> enc) -> f a -> Tagged False enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> f a -> enc
forall a. Options -> ToArgs enc arity a -> f a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs
    {-# INLINE consToJSON' #-}

--------------------------------------------------------------------------------

class RecordToPairs enc pairs arity f where
    -- 1st element: whole thing
    -- 2nd element: in case the record has only 1 field, just the value
    --              of the field (without the key); 'Nothing' otherwise
    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 :: forall a. Options -> ToArgs enc arity a -> (:*:) a b a -> pairs
recordToPairs Options
opts (ToArgs enc arity a
targs :: ToArgs enc arity p) (a a
a :*: b a
b) =
        a a -> pairs
forall (f :: * -> *).
RecordToPairs enc pairs arity f =>
f a -> pairs
pairsOf a a
a pairs -> pairs -> pairs
forall a. Monoid a => a -> a -> a
`mappend` b a -> pairs
forall (f :: * -> *).
RecordToPairs enc pairs arity f =>
f a -> pairs
pairsOf b a
b
      where
        pairsOf :: (RecordToPairs enc pairs arity f) => f p -> pairs
        pairsOf :: forall (f :: * -> *).
RecordToPairs enc pairs arity f =>
f a -> pairs
pairsOf = Options -> ToArgs enc arity a -> f a -> pairs
forall a. Options -> ToArgs enc arity a -> f a -> pairs
forall enc pairs arity (f :: * -> *) a.
RecordToPairs enc pairs arity f =>
Options -> ToArgs enc arity a -> f a -> pairs
recordToPairs Options
opts ToArgs enc arity a
targs
    {-# INLINE recordToPairs #-}

instance ( Selector s
         , GToJSON' enc arity (K1 i t)
         , KeyValuePair enc pairs
         , ToJSON t
         ) => RecordToPairs enc pairs arity (S1 s (K1 i t))
  where
    recordToPairs :: forall a. Options -> ToArgs enc arity a -> S1 s (K1 i t) a -> pairs
recordToPairs Options
opts ToArgs enc arity a
targs S1 s (K1 i t) a
m1
      | Options -> Bool
omitNothingFields Options
opts
      , t -> Bool
forall a. ToJSON a => a -> Bool
omitField (K1 i t a -> t
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 i t a -> t) -> K1 i t a -> t
forall a b. (a -> b) -> a -> b
$ S1 s (K1 i t) a -> K1 i t a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s (K1 i t) a
m1 :: t)
      = pairs
forall a. Monoid a => a
mempty

      | Bool
otherwise =
        let key :: Key
key   = [Char] -> Key
Key.fromString ([Char] -> Key) -> [Char] -> Key
forall a b. (a -> b) -> a -> b
$ Options -> [Char] -> [Char]
fieldLabelModifier Options
opts (S1 s (K1 i t) a -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName S1 s (K1 i t) a
m1)
            value :: enc
value = Options -> ToArgs enc arity a -> K1 i t a -> enc
forall a. Options -> ToArgs enc arity a -> K1 i t a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs (S1 s (K1 i t) a -> K1 i t a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s (K1 i t) a
m1)
         in Key
key Key -> enc -> pairs
forall v kv. KeyValuePair v kv => Key -> v -> kv
`pair` enc
value
    {-# INLINE recordToPairs #-}

instance ( Selector s
         , GToJSON' enc One (Rec1 f)
         , KeyValuePair enc pairs
         , ToJSON1 f
         ) => RecordToPairs enc pairs One (S1 s (Rec1 f))
  where
    recordToPairs :: forall a. Options -> ToArgs enc One a -> S1 s (Rec1 f) a -> pairs
recordToPairs Options
opts targs :: ToArgs enc One a
targs@(To1Args a -> Bool
o a -> enc
_ [a] -> enc
_) S1 s (Rec1 f) a
m1
      | Options -> Bool
omitNothingFields Options
opts
      , (a -> Bool) -> f a -> Bool
forall a. (a -> Bool) -> f a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o (f a -> Bool) -> f a -> Bool
forall a b. (a -> b) -> a -> b
$ Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1 (Rec1 f a -> f a) -> Rec1 f a -> f a
forall a b. (a -> b) -> a -> b
$ S1 s (Rec1 f) a -> Rec1 f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s (Rec1 f) a
m1
      = pairs
forall a. Monoid a => a
mempty

      | Bool
otherwise =
        let key :: Key
key   = [Char] -> Key
Key.fromString ([Char] -> Key) -> [Char] -> Key
forall a b. (a -> b) -> a -> b
$ Options -> [Char] -> [Char]
fieldLabelModifier Options
opts (S1 s (Rec1 f) a -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName S1 s (Rec1 f) a
m1)
            value :: enc
value = Options -> ToArgs enc One a -> Rec1 f a -> enc
forall a. Options -> ToArgs enc One a -> Rec1 f a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc One a
targs (S1 s (Rec1 f) a -> Rec1 f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s (Rec1 f) a
m1)
            in Key
key Key -> enc -> pairs
forall v kv. KeyValuePair v kv => Key -> v -> kv
`pair` enc
value
    {-# INLINE recordToPairs #-}

instance ( Selector s
         , GToJSON' enc One Par1
         , KeyValuePair enc pairs
         ) => RecordToPairs enc pairs One (S1 s Par1)
  where
    recordToPairs :: forall a. Options -> ToArgs enc One a -> S1 s Par1 a -> pairs
recordToPairs Options
opts targs :: ToArgs enc One a
targs@(To1Args a -> Bool
o a -> enc
_ [a] -> enc
_) S1 s Par1 a
m1
      | Options -> Bool
omitNothingFields Options
opts
      , a -> Bool
o (Par1 a -> a
forall p. Par1 p -> p
unPar1 (S1 s Par1 a -> Par1 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s Par1 a
m1))
      = pairs
forall a. Monoid a => a
mempty

      | Bool
otherwise =
        let key :: Key
key   = [Char] -> Key
Key.fromString ([Char] -> Key) -> [Char] -> Key
forall a b. (a -> b) -> a -> b
$ Options -> [Char] -> [Char]
fieldLabelModifier Options
opts (S1 s Par1 a -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName S1 s Par1 a
m1)
            value :: enc
value = Options -> ToArgs enc One a -> Par1 a -> enc
forall a. Options -> ToArgs enc One a -> Par1 a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc One a
targs (S1 s Par1 a -> Par1 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 S1 s Par1 a
m1)
          in Key
key Key -> enc -> pairs
forall v kv. KeyValuePair v kv => Key -> v -> kv
`pair` enc
value
    {-# INLINE recordToPairs #-}

--------------------------------------------------------------------------------

class WriteProduct arity f where
    writeProduct :: Options
                 -> ToArgs Value arity a
                 -> VM.MVector s Value
                 -> Int -- ^ index
                 -> Int -- ^ length
                 -> f a
                 -> ST s ()

instance ( WriteProduct arity a
         , WriteProduct arity b
         ) => WriteProduct arity (a :*: b) where
    writeProduct :: forall a s.
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> (:*:) a b a
-> ST s ()
writeProduct Options
opts ToArgs Value arity a
targs MVector s Value
mv Int
ix Int
len (a a
a :*: b a
b) = do
      Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> a a
-> ST s ()
forall a s.
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> a a
-> ST s ()
forall arity (f :: * -> *) a s.
WriteProduct arity f =>
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> f a
-> ST s ()
writeProduct Options
opts ToArgs Value arity a
targs MVector s Value
mv Int
ix  Int
lenL a a
a
      Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> b a
-> ST s ()
forall a s.
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> b a
-> ST s ()
forall arity (f :: * -> *) a s.
WriteProduct arity f =>
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> f a
-> ST s ()
writeProduct Options
opts ToArgs Value arity a
targs MVector s Value
mv Int
ixR Int
lenR b a
b
        where
          lenL :: Int
lenL = Int
len Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
          lenR :: Int
lenR = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenL
          ixR :: Int
ixR  = Int
ix  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenL
    {-# INLINE writeProduct #-}

instance {-# OVERLAPPABLE #-} (GToJSON' Value arity a) => WriteProduct arity a where
    writeProduct :: forall a s.
Options
-> ToArgs Value arity a
-> MVector s Value
-> Int
-> Int
-> a a
-> ST s ()
writeProduct Options
opts ToArgs Value arity a
targs MVector s Value
mv Int
ix Int
_ =
      MVector (PrimState (ST s)) Value -> Int -> Value -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.unsafeWrite MVector s Value
MVector (PrimState (ST s)) Value
mv Int
ix (Value -> ST s ()) -> (a a -> Value) -> a a -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs Value arity a -> a a -> Value
forall a. Options -> ToArgs Value arity a -> a a -> Value
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Value arity a
targs
    {-# INLINE writeProduct #-}

--------------------------------------------------------------------------------

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 :: forall a.
Options
-> ToArgs Encoding arity a -> (:*:) a b a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs (a a
a :*: b a
b) | Options -> Bool
omitNothingFields Options
opts =
        [Encoding' InArray] -> Encoding' InArray
forall a. [Encoding' a] -> Encoding' a
E.econcat ([Encoding' InArray] -> Encoding' InArray)
-> [Encoding' InArray] -> Encoding' InArray
forall a b. (a -> b) -> a -> b
$ Encoding' InArray -> [Encoding' InArray] -> [Encoding' InArray]
forall a. a -> [a] -> [a]
intersperse Encoding' InArray
forall a. Encoding' a
E.comma ([Encoding' InArray] -> [Encoding' InArray])
-> [Encoding' InArray] -> [Encoding' InArray]
forall a b. (a -> b) -> a -> b
$
        (Encoding' InArray -> Bool)
-> [Encoding' InArray] -> [Encoding' InArray]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Encoding' InArray -> Bool) -> Encoding' InArray -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' InArray -> Bool
forall a. Encoding' a -> Bool
E.nullEncoding)
        [Options -> ToArgs Encoding arity a -> a a -> Encoding' InArray
forall a.
Options -> ToArgs Encoding arity a -> a a -> Encoding' InArray
forall arity (f :: * -> *) a.
EncodeProduct arity f =>
Options -> ToArgs Encoding arity a -> f a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs a a
a, Options -> ToArgs Encoding arity a -> b a -> Encoding' InArray
forall a.
Options -> ToArgs Encoding arity a -> b a -> Encoding' InArray
forall arity (f :: * -> *) a.
EncodeProduct arity f =>
Options -> ToArgs Encoding arity a -> f a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs b a
b]
    encodeProduct Options
opts ToArgs Encoding arity a
targs (a a
a :*: b a
b) =
      Options -> ToArgs Encoding arity a -> a a -> Encoding' InArray
forall a.
Options -> ToArgs Encoding arity a -> a a -> Encoding' InArray
forall arity (f :: * -> *) a.
EncodeProduct arity f =>
Options -> ToArgs Encoding arity a -> f a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs a a
a Encoding' InArray -> Encoding' InArray -> Encoding' InArray
forall a b. Encoding' a -> Encoding' b -> Encoding' InArray
>*<
      Options -> ToArgs Encoding arity a -> b a -> Encoding' InArray
forall a.
Options -> ToArgs Encoding arity a -> b a -> Encoding' InArray
forall arity (f :: * -> *) a.
EncodeProduct arity f =>
Options -> ToArgs Encoding arity a -> f a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs b a
b
    {-# INLINE encodeProduct #-}

instance {-# OVERLAPPABLE #-} (GToJSON' Encoding arity a) => EncodeProduct arity a where
    encodeProduct :: forall a.
Options -> ToArgs Encoding arity a -> a a -> Encoding' InArray
encodeProduct Options
opts ToArgs Encoding arity a
targs a a
a = Encoding -> Encoding' InArray
forall a b. Encoding' a -> Encoding' b
E.retagEncoding (Encoding -> Encoding' InArray) -> Encoding -> Encoding' InArray
forall a b. (a -> b) -> a -> b
$ Options -> ToArgs Encoding arity a -> a a -> Encoding
forall a. Options -> ToArgs Encoding arity a -> a a -> Encoding
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs Encoding arity a
targs a a
a
    {-# INLINE encodeProduct #-}

--------------------------------------------------------------------------------

instance ( GToJSON'   enc arity a
         , ConsToJSON enc arity a
         , FromPairs  enc pairs
         , KeyValuePair  enc pairs
         , Constructor c
         ) => SumToJSON' ObjectWithSingleField enc arity (C1 c a)
  where
    sumToJSON' :: forall a.
Options
-> ToArgs enc arity a
-> C1 c a a
-> Tagged ObjectWithSingleField enc
sumToJSON' Options
opts ToArgs enc arity a
targs =
      enc -> Tagged ObjectWithSingleField enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged ObjectWithSingleField enc)
-> (C1 c a a -> enc)
-> C1 c a a
-> Tagged ObjectWithSingleField enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pairs -> enc
forall enc pairs. FromPairs enc pairs => pairs -> enc
fromPairs (pairs -> enc) -> (C1 c a a -> pairs) -> C1 c a a -> enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
typ Key -> enc -> pairs
forall v kv. KeyValuePair v kv => Key -> v -> kv
`pair`) (enc -> pairs) -> (C1 c a a -> enc) -> C1 c a a -> pairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> C1 c a a -> enc
forall a. Options -> ToArgs enc arity a -> M1 C c a a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs
        where
          typ :: Key
typ = [Char] -> Key
Key.fromString ([Char] -> Key) -> [Char] -> Key
forall a b. (a -> b) -> a -> b
$ Options -> [Char] -> [Char]
constructorTagModifier Options
opts ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
                         Any c a Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName (t c a p
forall {k} {t :: Meta -> (* -> *) -> k -> *} {p :: k}. t c a p
forall a. HasCallStack => a
undefined :: t c a p)
    {-# INLINE sumToJSON' #-}

--------------------------------------------------------------------------------

instance {-# OVERLAPPABLE #-}
    ( ConsToJSON enc arity a
    ) => SumToJSON' UntaggedValue enc arity (C1 c a)
  where
    sumToJSON' :: forall a.
Options
-> ToArgs enc arity a -> C1 c a a -> Tagged UntaggedValue enc
sumToJSON' Options
opts ToArgs enc arity a
targs = enc -> Tagged UntaggedValue enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged UntaggedValue enc)
-> (C1 c a a -> enc) -> C1 c a a -> Tagged UntaggedValue enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ToArgs enc arity a -> C1 c a a -> enc
forall a. Options -> ToArgs enc arity a -> M1 C c a a -> enc
forall enc arity (f :: * -> *) a.
GToJSON' enc arity f =>
Options -> ToArgs enc arity a -> f a -> enc
gToJSON Options
opts ToArgs enc arity a
targs
    {-# INLINE sumToJSON' #-}

instance {-# OVERLAPPING #-}
    ( Constructor c
    , IsString enc
    ) => SumToJSON' UntaggedValue enc arity (C1 c U1)
  where
    sumToJSON' :: forall a.
Options
-> ToArgs enc arity a -> C1 c U1 a -> Tagged UntaggedValue enc
sumToJSON' Options
opts ToArgs enc arity a
_ C1 c U1 a
_ = enc -> Tagged UntaggedValue enc
forall {k} (s :: k) b. b -> Tagged s b
Tagged (enc -> Tagged UntaggedValue enc)
-> ([Char] -> enc) -> [Char] -> Tagged UntaggedValue enc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> enc
forall a. IsString a => [Char] -> a
fromString ([Char] -> Tagged UntaggedValue enc)
-> [Char] -> Tagged UntaggedValue enc
forall a b. (a -> b) -> a -> b
$
        Options -> [Char] -> [Char]
constructorTagModifier Options
opts ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Any c U1 Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName (t c U1 p
forall {k} {k} {t :: Meta -> (k -> *) -> k -> *} {p :: k}. t c U1 p
forall a. HasCallStack => a
undefined :: t c U1 p)
    {-# INLINE sumToJSON' #-}

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
-- base
-------------------------------------------------------------------------------

instance ToJSON2 Const where
    liftToJSON2 :: forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> Const a b
-> Value
liftToJSON2 a -> Bool
_ a -> Value
t [a] -> Value
_ b -> Bool
_ b -> Value
_ [b] -> Value
_ (Const a
x) = a -> Value
t a
x
    liftToEncoding2 :: forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> Const a b
-> Encoding
liftToEncoding2 a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ b -> Bool
_ b -> Encoding
_ [b] -> Encoding
_ (Const a
x) = a -> Encoding
t a
x
    liftOmitField2 :: forall a b. (a -> Bool) -> (b -> Bool) -> Const a b -> Bool
liftOmitField2 a -> Bool
o b -> Bool
_ (Const a
x) = a -> Bool
o a
x

instance ToJSON a => ToJSON1 (Const a) where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Const a a -> Value
liftToJSON a -> Bool
_ a -> Value
_ [a] -> Value
_ (Const a
x) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Const a a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
_ [a] -> Encoding
_ (Const a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding a
x
    liftOmitField :: forall a. (a -> Bool) -> Const a a -> Bool
liftOmitField a -> Bool
_ (Const a
x) = a -> Bool
forall a. ToJSON a => a -> Bool
omitField a
x

instance ToJSON a => ToJSON (Const a b) where
    toJSON :: Const a b -> Value
toJSON (Const a
x) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x
    toEncoding :: Const a b -> Encoding
toEncoding (Const a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding a
x
    omitField :: Const a b -> Bool
omitField (Const a
x) = a -> Bool
forall a. ToJSON a => a -> Bool
omitField a
x

instance (ToJSON a, ToJSONKey a) => ToJSONKey (Const a b) where
    toJSONKey :: ToJSONKeyFunction (Const a b)
toJSONKey = (Const a b -> a)
-> ToJSONKeyFunction a -> ToJSONKeyFunction (Const a b)
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst ToJSONKeyFunction a
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey


instance ToJSON1 Maybe where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Maybe a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ (Just a
a) = a -> Value
t a
a
    liftToJSON a -> Bool
_ a -> Value
_  [a] -> Value
_ Maybe a
Nothing  = Value
Null

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Maybe a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ (Just a
a) = a -> Encoding
t a
a
    liftToEncoding a -> Bool
_ a -> Encoding
_  [a] -> Encoding
_ Maybe a
Nothing  = Encoding
E.null_

    liftOmitField :: forall a. (a -> Bool) -> Maybe a -> Bool
liftOmitField a -> Bool
_ = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing

instance (ToJSON a) => ToJSON (Maybe a) where
    toJSON :: Maybe a -> Value
toJSON = Maybe a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    omitField :: Maybe a -> Bool
omitField = Maybe a -> Bool
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Bool
omitField1
    toEncoding :: Maybe a -> Encoding
toEncoding = Maybe a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1


instance ToJSON2 Either where
    liftToJSON2 :: forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> Either a b
-> Value
liftToJSON2 a -> Bool
_  a -> Value
toA [a] -> Value
_ b -> Bool
_ b -> Value
_toB [b] -> Value
_ (Left a
a)  = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KM.singleton Key
"Left"  (a -> Value
toA a
a)
    liftToJSON2 a -> Bool
_ a -> Value
_toA [a] -> Value
_ b -> Bool
_  b -> Value
toB [b] -> Value
_ (Right b
b) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KM.singleton Key
"Right" (b -> Value
toB b
b)

    liftToEncoding2 :: forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> Either a b
-> Encoding
liftToEncoding2 a -> Bool
_  a -> Encoding
toA [a] -> Encoding
_ b -> Bool
_ b -> Encoding
_toB [b] -> Encoding
_ (Left a
a) = Series -> Encoding
E.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
E.pair Key
"Left" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ a -> Encoding
toA a
a
    liftToEncoding2 a -> Bool
_ a -> Encoding
_toA [a] -> Encoding
_ b -> Bool
_ b -> Encoding
toB [b] -> Encoding
_ (Right b
b) = Series -> Encoding
E.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
E.pair Key
"Right" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ b -> Encoding
toB b
b

instance (ToJSON a) => ToJSON1 (Either a) where
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> Either a a -> Value
liftToJSON = (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> Either a a
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> Either a b
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2 a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Either a a -> Encoding
liftToEncoding = (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> Either a a
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> Either a b
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
liftToEncoding2 a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList

instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
    toJSON :: Either a b -> Value
toJSON = Either a b -> Value
forall (f :: * -> * -> *) a b.
(ToJSON2 f, ToJSON a, ToJSON b) =>
f a b -> Value
toJSON2
    toEncoding :: Either a b -> Encoding
toEncoding = Either a b -> Encoding
forall (f :: * -> * -> *) a b.
(ToJSON2 f, ToJSON a, ToJSON b) =>
f a b -> Encoding
toEncoding2

instance ToJSON Void where
    toJSON :: Void -> Value
toJSON = Void -> Value
forall a. Void -> a
absurd
    toEncoding :: Void -> Encoding
toEncoding = Void -> Encoding
forall a. Void -> a
absurd

-- | @since 2.1.2.0
instance ToJSONKey Void where
    toJSONKey :: ToJSONKeyFunction Void
toJSONKey = (Void -> Key) -> (Void -> Encoding' Key) -> ToJSONKeyFunction Void
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText Void -> Key
forall a. Void -> a
absurd Void -> Encoding' Key
forall a. Void -> a
absurd

instance ToJSON Bool where
    toJSON :: Bool -> Value
toJSON = Bool -> Value
Bool
    toEncoding :: Bool -> Encoding
toEncoding = Bool -> Encoding
E.bool

instance ToJSONKey Bool where
    toJSONKey :: ToJSONKeyFunction Bool
toJSONKey = (Bool -> Text) -> ToJSONKeyFunction Bool
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((Bool -> Text) -> ToJSONKeyFunction Bool)
-> (Bool -> Text) -> ToJSONKeyFunction Bool
forall a b. (a -> b) -> a -> b
$ \Bool
x -> if Bool
x then Text
"true" else Text
"false"


instance ToJSON Ordering where
  toJSON :: Ordering -> Value
toJSON     = Text -> Value
forall a. ToJSON a => a -> Value
toJSON     (Text -> Value) -> (Ordering -> Text) -> Ordering -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Text
orderingToText
  toEncoding :: Ordering -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (Ordering -> Text) -> Ordering -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Text
orderingToText

orderingToText :: Ordering -> T.Text
orderingToText :: Ordering -> Text
orderingToText Ordering
o = case Ordering
o of
                     Ordering
LT -> Text
"LT"
                     Ordering
EQ -> Text
"EQ"
                     Ordering
GT -> Text
"GT"

instance ToJSON () where
    toJSON :: () -> Value
toJSON ()
_ = Value
emptyArray
    toEncoding :: () -> Encoding
toEncoding ()
_ = Encoding
emptyArray_
    omitField :: () -> Bool
omitField ()
_ = Bool
True


instance ToJSON Char where
    toJSON :: Char -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Char -> Text) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
    toJSONList :: [Char] -> Value
toJSONList = Text -> Value
String (Text -> Value) -> ([Char] -> Text) -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

    toEncoding :: Char -> Encoding
toEncoding = [Char] -> Encoding
forall a. [Char] -> Encoding' a
E.string ([Char] -> Encoding) -> (Char -> [Char]) -> Char -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[])
    toEncodingList :: [Char] -> Encoding
toEncodingList = [Char] -> Encoding
forall a. [Char] -> Encoding' a
E.string


instance ToJSON Double where
    toJSON :: Double -> Value
toJSON = Double -> Value
forall a. RealFloat a => a -> Value
realFloatToJSON
    toEncoding :: Double -> Encoding
toEncoding = Double -> Encoding
E.double

instance ToJSONKey Double where
    toJSONKey :: ToJSONKeyFunction Double
toJSONKey = (Double -> Encoding' Key) -> ToJSONKeyFunction Double
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Double -> Encoding' Key
forall a. Double -> Encoding' a
E.doubleText

instance ToJSON Float where
    toJSON :: Float -> Value
toJSON = Float -> Value
forall a. RealFloat a => a -> Value
realFloatToJSON
    toEncoding :: Float -> Encoding
toEncoding = Float -> Encoding
E.float

instance ToJSONKey Float where
    toJSONKey :: ToJSONKeyFunction Float
toJSONKey = (Float -> Encoding' Key) -> ToJSONKeyFunction Float
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Float -> Encoding' Key
forall a. Float -> Encoding' a
E.floatText


instance (ToJSON a, Integral a) => ToJSON (Ratio a) where
    toJSON :: Ratio a -> Value
toJSON Ratio a
r = [(Key, Value)] -> Value
object [ Key
"numerator"   Key -> a -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Ratio a -> a
forall a. Ratio a -> a
numerator   Ratio a
r
                      , Key
"denominator" Key -> a -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r
                      ]

    toEncoding :: Ratio a -> Encoding
toEncoding Ratio a
r = Series -> Encoding
E.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        Key
"numerator" Key -> a -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        Key
"denominator" Key -> a -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r


instance HasResolution a => ToJSON (Fixed a) where
    toJSON :: Fixed a -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value)
-> (Fixed a -> Scientific) -> Fixed a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    toEncoding :: Fixed a -> Encoding
toEncoding = Scientific -> Encoding
E.scientific (Scientific -> Encoding)
-> (Fixed a -> Scientific) -> Fixed a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance HasResolution a => ToJSONKey (Fixed a) where
    toJSONKey :: ToJSONKeyFunction (Fixed a)
toJSONKey = (Fixed a -> Encoding' Key) -> ToJSONKeyFunction (Fixed a)
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc (Scientific -> Encoding' Key
forall a. Scientific -> Encoding' a
E.scientificText (Scientific -> Encoding' Key)
-> (Fixed a -> Scientific) -> Fixed a -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac)

instance ToJSON Int where
    toJSON :: Int -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Int -> Scientific) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Int -> Encoding
toEncoding = Int -> Encoding
E.int

instance ToJSONKey Int where
    toJSONKey :: ToJSONKeyFunction Int
toJSONKey = (Int -> Encoding' Key) -> ToJSONKeyFunction Int
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Int -> Encoding' Key
forall a. Int -> Encoding' a
E.intText


instance ToJSON Integer where
    toJSON :: Integer -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value)
-> (Integer -> Scientific) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger
    toEncoding :: Integer -> Encoding
toEncoding = Integer -> Encoding
E.integer

instance ToJSONKey Integer where
    toJSONKey :: ToJSONKeyFunction Integer
toJSONKey = (Integer -> Encoding' Key) -> ToJSONKeyFunction Integer
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Integer -> Encoding' Key
forall a. Integer -> Encoding' a
E.integerText


instance ToJSON Natural where
    toJSON :: Natural -> Value
toJSON = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> (Natural -> Integer) -> Natural -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
    toEncoding :: Natural -> Encoding
toEncoding = Integer -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Integer -> Encoding)
-> (Natural -> Integer) -> Natural -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger

instance ToJSONKey Natural where
    toJSONKey :: ToJSONKeyFunction Natural
toJSONKey = (Natural -> Encoding' Key) -> ToJSONKeyFunction Natural
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc (Integer -> Encoding' Key
forall a. Integer -> Encoding' a
E.integerText (Integer -> Encoding' Key)
-> (Natural -> Integer) -> Natural -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger)


instance ToJSON Int8 where
    toJSON :: Int8 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Int8 -> Scientific) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Int8 -> Encoding
toEncoding = Int8 -> Encoding
E.int8

instance ToJSONKey Int8 where
    toJSONKey :: ToJSONKeyFunction Int8
toJSONKey = (Int8 -> Encoding' Key) -> ToJSONKeyFunction Int8
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Int8 -> Encoding' Key
forall a. Int8 -> Encoding' a
E.int8Text


instance ToJSON Int16 where
    toJSON :: Int16 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Int16 -> Scientific) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Int16 -> Encoding
toEncoding = Int16 -> Encoding
E.int16

instance ToJSONKey Int16 where
    toJSONKey :: ToJSONKeyFunction Int16
toJSONKey = (Int16 -> Encoding' Key) -> ToJSONKeyFunction Int16
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Int16 -> Encoding' Key
forall a. Int16 -> Encoding' a
E.int16Text


instance ToJSON Int32 where
    toJSON :: Int32 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Int32 -> Scientific) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Int32 -> Encoding
toEncoding = Int32 -> Encoding
E.int32

instance ToJSONKey Int32 where
    toJSONKey :: ToJSONKeyFunction Int32
toJSONKey = (Int32 -> Encoding' Key) -> ToJSONKeyFunction Int32
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Int32 -> Encoding' Key
forall a. Int32 -> Encoding' a
E.int32Text


instance ToJSON Int64 where
    toJSON :: Int64 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Int64 -> Scientific) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Int64 -> Encoding
toEncoding = Int64 -> Encoding
E.int64

instance ToJSONKey Int64 where
    toJSONKey :: ToJSONKeyFunction Int64
toJSONKey = (Int64 -> Encoding' Key) -> ToJSONKeyFunction Int64
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Int64 -> Encoding' Key
forall a. Int64 -> Encoding' a
E.int64Text

instance ToJSON Word where
    toJSON :: Word -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Word -> Scientific) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Word -> Encoding
toEncoding = Word -> Encoding
E.word

instance ToJSONKey Word where
    toJSONKey :: ToJSONKeyFunction Word
toJSONKey = (Word -> Encoding' Key) -> ToJSONKeyFunction Word
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Word -> Encoding' Key
forall a. Word -> Encoding' a
E.wordText


instance ToJSON Word8 where
    toJSON :: Word8 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Word8 -> Scientific) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Word8 -> Encoding
toEncoding = Word8 -> Encoding
E.word8

instance ToJSONKey Word8 where
    toJSONKey :: ToJSONKeyFunction Word8
toJSONKey = (Word8 -> Encoding' Key) -> ToJSONKeyFunction Word8
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Word8 -> Encoding' Key
forall a. Word8 -> Encoding' a
E.word8Text


instance ToJSON Word16 where
    toJSON :: Word16 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Word16 -> Scientific) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Word16 -> Encoding
toEncoding = Word16 -> Encoding
E.word16

instance ToJSONKey Word16 where
    toJSONKey :: ToJSONKeyFunction Word16
toJSONKey = (Word16 -> Encoding' Key) -> ToJSONKeyFunction Word16
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Word16 -> Encoding' Key
forall a. Word16 -> Encoding' a
E.word16Text


instance ToJSON Word32 where
    toJSON :: Word32 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Word32 -> Scientific) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Word32 -> Encoding
toEncoding = Word32 -> Encoding
E.word32

instance ToJSONKey Word32 where
    toJSONKey :: ToJSONKeyFunction Word32
toJSONKey = (Word32 -> Encoding' Key) -> ToJSONKeyFunction Word32
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Word32 -> Encoding' Key
forall a. Word32 -> Encoding' a
E.word32Text


instance ToJSON Word64 where
    toJSON :: Word64 -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Word64 -> Scientific) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toEncoding :: Word64 -> Encoding
toEncoding = Word64 -> Encoding
E.word64

instance ToJSONKey Word64 where
    toJSONKey :: ToJSONKeyFunction Word64
toJSONKey = (Word64 -> Encoding' Key) -> ToJSONKeyFunction Word64
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Word64 -> Encoding' Key
forall a. Word64 -> Encoding' a
E.word64Text

instance ToJSON CTime where
    toJSON :: CTime -> Value
toJSON (CTime Int64
i) = Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
i
    toEncoding :: CTime -> Encoding
toEncoding (CTime Int64
i) = Int64 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Int64
i

instance ToJSON Text where
    toJSON :: Text -> Value
toJSON = Text -> Value
String
    toEncoding :: Text -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
E.text

instance ToJSONKey Text where
    toJSONKey :: ToJSONKeyFunction Text
toJSONKey = (Text -> Text) -> ToJSONKeyFunction Text
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Text -> Text
forall a. a -> a
id

instance ToJSON LT.Text where
    toJSON :: Text -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict
    toEncoding :: Text -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
E.lazyText

instance ToJSONKey LT.Text where
    toJSONKey :: ToJSONKeyFunction Text
toJSONKey = (Text -> Text) -> ToJSONKeyFunction Text
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Text -> Text
LT.toStrict

-- | @since 2.0.2.0
instance ToJSON ST.ShortText where
    toJSON :: ShortText -> Value
toJSON = Text -> Value
String (Text -> Value) -> (ShortText -> Text) -> ShortText -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ST.toText
    toEncoding :: ShortText -> Encoding
toEncoding = ShortText -> Encoding
forall a. ShortText -> Encoding' a
E.shortText

-- | @since 2.0.2.0
instance ToJSONKey ST.ShortText where
    toJSONKey :: ToJSONKeyFunction ShortText
toJSONKey = (ShortText -> Key)
-> (ShortText -> Encoding' Key) -> ToJSONKeyFunction ShortText
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText ShortText -> Key
Key.fromShortText ShortText -> Encoding' Key
forall a. ShortText -> Encoding' a
E.shortText


instance ToJSON Version where
    toJSON :: Version -> Value
toJSON = [Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> (Version -> [Char]) -> Version -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Char]
showVersion
    toEncoding :: Version -> Encoding
toEncoding = [Char] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([Char] -> Encoding) -> (Version -> [Char]) -> Version -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Char]
showVersion

instance ToJSONKey Version where
    toJSONKey :: ToJSONKeyFunction Version
toJSONKey = (Version -> Key) -> ToJSONKeyFunction Version
forall a. (a -> Key) -> ToJSONKeyFunction a
toJSONKeyKey ([Char] -> Key
Key.fromString ([Char] -> Key) -> (Version -> [Char]) -> Version -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Char]
showVersion)

-------------------------------------------------------------------------------
-- semigroups NonEmpty
-------------------------------------------------------------------------------

instance ToJSON1 NonEmpty where
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> NonEmpty a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
t ([a] -> Value) -> (NonEmpty a -> [a]) -> NonEmpty a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> NonEmpty a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t ([a] -> Encoding) -> (NonEmpty a -> [a]) -> NonEmpty a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList

instance (ToJSON a) => ToJSON (NonEmpty a) where
    toJSON :: NonEmpty a -> Value
toJSON = NonEmpty a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: NonEmpty a -> Encoding
toEncoding = NonEmpty a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-------------------------------------------------------------------------------
-- scientific
-------------------------------------------------------------------------------

instance ToJSON Scientific where
    toJSON :: Scientific -> Value
toJSON = Scientific -> Value
Number
    toEncoding :: Scientific -> Encoding
toEncoding = Scientific -> Encoding
E.scientific

instance ToJSONKey Scientific where
    toJSONKey :: ToJSONKeyFunction Scientific
toJSONKey = (Scientific -> Encoding' Key) -> ToJSONKeyFunction Scientific
forall a. (a -> Encoding' Key) -> ToJSONKeyFunction a
toJSONKeyTextEnc Scientific -> Encoding' Key
forall a. Scientific -> Encoding' a
E.scientificText

-------------------------------------------------------------------------------
-- DList
-------------------------------------------------------------------------------

instance ToJSON1 DList.DList where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> DList a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
t ([a] -> Value) -> (DList a -> [a]) -> DList a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> DList a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t ([a] -> Encoding) -> (DList a -> [a]) -> DList a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance (ToJSON a) => ToJSON (DList.DList a) where
    toJSON :: DList a -> Value
toJSON = DList a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: DList a -> Encoding
toEncoding = DList a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-- | @since 1.5.3.0
instance ToJSON1 DNE.DNonEmpty where
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> DNonEmpty a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
t ([a] -> Value) -> (DNonEmpty a -> [a]) -> DNonEmpty a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNonEmpty a -> [a]
forall a. DNonEmpty a -> [a]
DNE.toList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> DNonEmpty a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t ([a] -> Encoding)
-> (DNonEmpty a -> [a]) -> DNonEmpty a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNonEmpty a -> [a]
forall a. DNonEmpty a -> [a]
DNE.toList

-- | @since 1.5.3.0
instance (ToJSON a) => ToJSON (DNE.DNonEmpty a) where
    toJSON :: DNonEmpty a -> Value
toJSON = DNonEmpty a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: DNonEmpty a -> Encoding
toEncoding = DNonEmpty a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-------------------------------------------------------------------------------
-- OneTuple
-------------------------------------------------------------------------------

-- | @since 2.0.2.0
instance ToJSON1 Solo where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Solo a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ (Solo a
a) = a -> Value
t a
a
    liftToJSONList :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [Solo a] -> Value
liftToJSONList a -> Bool
_ a -> Value
_ [a] -> Value
tl [Solo a]
xs = [a] -> Value
tl ((Solo a -> a) -> [Solo a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Solo a -> a
forall a. Solo a -> a
getSolo [Solo a]
xs)

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Solo a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ (Solo a
a) = a -> Encoding
t a
a
    liftToEncodingList :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [Solo a] -> Encoding
liftToEncodingList a -> Bool
_ a -> Encoding
_ [a] -> Encoding
tl [Solo a]
xs = [a] -> Encoding
tl ((Solo a -> a) -> [Solo a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Solo a -> a
forall a. Solo a -> a
getSolo [Solo a]
xs)

-- | @since 2.0.2.0
instance (ToJSON a) => ToJSON (Solo a) where
    toJSON :: Solo a -> Value
toJSON = Solo a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toJSONList :: [Solo a] -> Value
toJSONList = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [Solo a] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [Solo a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList

    toEncoding :: Solo a -> Encoding
toEncoding = Solo a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1
    toEncodingList :: [Solo a] -> Encoding
toEncodingList = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [Solo a] -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [Solo a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList

-- | @since 2.0.2.0
instance (ToJSONKey a) => ToJSONKey (Solo a) where
    toJSONKey :: ToJSONKeyFunction (Solo a)
toJSONKey = (Solo a -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction (Solo a)
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramapToJSONKeyFunction Solo a -> a
forall a. Solo a -> a
getSolo ToJSONKeyFunction a
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey
    toJSONKeyList :: ToJSONKeyFunction [Solo a]
toJSONKeyList = ([Solo a] -> [a])
-> ToJSONKeyFunction [a] -> ToJSONKeyFunction [Solo a]
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramapToJSONKeyFunction ((Solo a -> a) -> [Solo a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Solo a -> a
forall a. Solo a -> a
getSolo) ToJSONKeyFunction [a]
forall a. ToJSONKey a => ToJSONKeyFunction [a]
toJSONKeyList

-------------------------------------------------------------------------------
-- transformers - Functors
-------------------------------------------------------------------------------

instance ToJSON1 Identity where
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> Identity a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ (Identity a
a) = a -> Value
t a
a
    liftToJSONList :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> [Identity a] -> Value
liftToJSONList a -> Bool
_ a -> Value
_ [a] -> Value
tl [Identity a]
xs = [a] -> Value
tl ((Identity a -> a) -> [Identity a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Identity a -> a
forall a. Identity a -> a
runIdentity [Identity a]
xs)

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Identity a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ (Identity a
a) = a -> Encoding
t a
a
    liftToEncodingList :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [Identity a] -> Encoding
liftToEncodingList a -> Bool
_ a -> Encoding
_ [a] -> Encoding
tl [Identity a]
xs = [a] -> Encoding
tl ((Identity a -> a) -> [Identity a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Identity a -> a
forall a. Identity a -> a
runIdentity [Identity a]
xs)

    liftOmitField :: forall a. (a -> Bool) -> Identity a -> Bool
liftOmitField a -> Bool
o (Identity a
a) = a -> Bool
o a
a

instance (ToJSON a) => ToJSON (Identity a) where
    toJSON :: Identity a -> Value
toJSON = Identity a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toJSONList :: [Identity a] -> Value
toJSONList = (a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> [Identity a] -> Value
forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> [Identity a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList

    toEncoding :: Identity a -> Encoding
toEncoding = Identity a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1
    toEncodingList :: [Identity a] -> Encoding
toEncodingList = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [Identity a] -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [Identity a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList

    omitField :: Identity a -> Bool
omitField (Identity a
x) = a -> Bool
forall a. ToJSON a => a -> Bool
omitField a
x

instance (ToJSONKey a) => ToJSONKey (Identity a) where
    toJSONKey :: ToJSONKeyFunction (Identity a)
toJSONKey = (Identity a -> a)
-> ToJSONKeyFunction a -> ToJSONKeyFunction (Identity a)
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramapToJSONKeyFunction Identity a -> a
forall a. Identity a -> a
runIdentity ToJSONKeyFunction a
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey
    toJSONKeyList :: ToJSONKeyFunction [Identity a]
toJSONKeyList = ([Identity a] -> [a])
-> ToJSONKeyFunction [a] -> ToJSONKeyFunction [Identity a]
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
contramapToJSONKeyFunction ((Identity a -> a) -> [Identity a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Identity a -> a
forall a. Identity a -> a
runIdentity) ToJSONKeyFunction [a]
forall a. ToJSONKey a => ToJSONKeyFunction [a]
toJSONKeyList


instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Compose f g) where
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> Compose f g a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl (Compose f (g a)
x) = (g a -> Bool)
-> (g a -> Value) -> ([g a] -> Value) -> f (g a) -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) g a -> Value
g [g a] -> Value
gl f (g a)
x
      where
        g :: g a -> Value
g = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl
        gl :: [g a] -> Value
gl = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [g a] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [g a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
o a -> Value
tv [a] -> Value
tvl

    liftToJSONList :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> [Compose f g a] -> Value
liftToJSONList a -> Bool
o a -> Value
te [a] -> Value
tel [Compose f g a]
xs = (g a -> Bool)
-> (g a -> Value) -> ([g a] -> Value) -> [f (g a)] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) g a -> Value
g [g a] -> Value
gl ((Compose f g a -> f (g a)) -> [Compose f g a] -> [f (g a)]
forall a b. (a -> b) -> [a] -> [b]
map Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose [Compose f g a]
xs)
      where
        g :: g a -> Value
g = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
te [a] -> Value
tel
        gl :: [g a] -> Value
gl = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [g a] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [g a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
o a -> Value
te [a] -> Value
tel

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> Compose f g a
-> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel (Compose f (g a)
x) = (g a -> Bool)
-> (g a -> Encoding) -> ([g a] -> Encoding) -> f (g a) -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) g a -> Encoding
g [g a] -> Encoding
gl f (g a)
x
      where
        g :: g a -> Encoding
g = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel
        gl :: [g a] -> Encoding
gl = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [g a] -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [g a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
o a -> Encoding
te [a] -> Encoding
tel

    liftToEncodingList :: forall a.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> [Compose f g a]
-> Encoding
liftToEncodingList a -> Bool
o a -> Encoding
te [a] -> Encoding
tel [Compose f g a]
xs = (g a -> Bool)
-> (g a -> Encoding)
-> ([g a] -> Encoding)
-> [f (g a)]
-> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) g a -> Encoding
g [g a] -> Encoding
gl ((Compose f g a -> f (g a)) -> [Compose f g a] -> [f (g a)]
forall a b. (a -> b) -> [a] -> [b]
map Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose [Compose f g a]
xs)
      where
        g :: g a -> Encoding
g = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel
        gl :: [g a] -> Encoding
gl = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [g a] -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [g a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
o a -> Encoding
te [a] -> Encoding
tel

    liftOmitField :: forall a. (a -> Bool) -> Compose f g a -> Bool
liftOmitField a -> Bool
o (Compose f (g a)
xs)= (g a -> Bool) -> f (g a) -> Bool
forall a. (a -> Bool) -> f a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) f (g a)
xs

instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where
    toJSON :: Compose f g a -> Value
toJSON = Compose f g a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toJSONList :: [Compose f g a] -> Value
toJSONList = (a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> [Compose f g a] -> Value
forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> [Compose f g a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Value
forall a. ToJSON a => a -> Value
toJSON [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList
    toEncoding :: Compose f g a -> Encoding
toEncoding = Compose f g a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1
    toEncodingList :: [Compose f g a] -> Encoding
toEncodingList = (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> [Compose f g a]
-> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> [Compose f g a]
-> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
forall a. ToJSON a => a -> Bool
omitField a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList
    omitField :: Compose f g a -> Bool
omitField = Compose f g a -> Bool
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Bool
omitField1

instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where
    liftToJSON :: forall a.
(a -> Bool)
-> (a -> Value) -> ([a] -> Value) -> Product f g a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl (Pair f a
x g a
y) = (f a -> Bool)
-> (f a -> Value)
-> ([f a] -> Value)
-> (g a -> Bool)
-> (g a -> Value)
-> ([g a] -> Value)
-> (f a, g a)
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> (a, b)
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2 ((a -> Bool) -> f a -> Bool
forall a. (a -> Bool) -> f a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) f a -> Value
tx [f a] -> Value
txl ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) g a -> Value
ty [g a] -> Value
tyl (f a
x, g a
y)
      where
        tx :: f a -> Value
tx = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl
        txl :: [f a] -> Value
txl = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
o a -> Value
tv [a] -> Value
tvl
        ty :: g a -> Value
ty = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl
        tyl :: [g a] -> Value
tyl = (a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [g a] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [g a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList a -> Bool
o a -> Value
tv [a] -> Value
tvl

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> Product f g a
-> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel (Pair f a
x g a
y) = (f a -> Bool)
-> (f a -> Encoding)
-> ([f a] -> Encoding)
-> (g a -> Bool)
-> (g a -> Encoding)
-> ([g a] -> Encoding)
-> (f a, g a)
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> (a, b)
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
liftToEncoding2 ((a -> Bool) -> f a -> Bool
forall a. (a -> Bool) -> f a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) f a -> Encoding
tx [f a] -> Encoding
txl ((a -> Bool) -> g a -> Bool
forall a. (a -> Bool) -> g a -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) g a -> Encoding
ty [g a] -> Encoding
tyl (f a
x, g a
y)
      where
        tx :: f a -> Encoding
tx = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel
        txl :: [f a] -> Encoding
txl = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
o a -> Encoding
te [a] -> Encoding
tel
        ty :: g a -> Encoding
ty = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel
        tyl :: [g a] -> Encoding
tyl = (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [g a] -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [g a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList a -> Bool
o a -> Encoding
te [a] -> Encoding
tel

instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where
    toJSON :: Product f g a -> Value
toJSON = Product f g a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Product f g a -> Encoding
toEncoding = Product f g a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Sum f g a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl (InL f a
x) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KM.singleton Key
"InL" ((a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl f a
x)
    liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl (InR g a
y) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KM.singleton Key
"InR" ((a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> g a -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Bool
o a -> Value
tv [a] -> Value
tvl g a
y)

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Sum f g a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel (InL f a
x) = Series -> Encoding
E.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
E.pair Key
"InL" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel f a
x
    liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel (InR g a
y) = Series -> Encoding
E.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
E.pair Key
"InR" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ (a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> g a -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
te [a] -> Encoding
tel g a
y

instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where
    toJSON :: Sum f g a -> Value
toJSON = Sum f g a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Sum f g a -> Encoding
toEncoding = Sum f g a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-------------------------------------------------------------------------------
-- containers
-------------------------------------------------------------------------------

instance ToJSON1 Seq.Seq where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Seq a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
t ([a] -> Value) -> (Seq a -> [a]) -> Seq a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Seq a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t ([a] -> Encoding) -> (Seq a -> [a]) -> Seq a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance (ToJSON a) => ToJSON (Seq.Seq a) where
    toJSON :: Seq a -> Value
toJSON = Seq a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Seq a -> Encoding
toEncoding = Seq a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1


instance ToJSON1 Set.Set where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Set a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
t ([a] -> Value) -> (Set a -> [a]) -> Set a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Set a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t ([a] -> Encoding) -> (Set a -> [a]) -> Set a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

instance (ToJSON a) => ToJSON (Set.Set a) where
    toJSON :: Set a -> Value
toJSON = Set a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Set a -> Encoding
toEncoding = Set a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1


instance ToJSON IntSet.IntSet where
    toJSON :: IntSet -> Value
toJSON = [Int] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Int] -> Value) -> (IntSet -> [Int]) -> IntSet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList
    toEncoding :: IntSet -> Encoding
toEncoding = [Int] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([Int] -> Encoding) -> (IntSet -> [Int]) -> IntSet -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList

instance ToJSON1 IntMap.IntMap where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> IntMap a -> Value
liftToJSON a -> Bool
o a -> Value
t [a] -> Value
tol = ((Int, a) -> Bool)
-> ((Int, a) -> Value)
-> ([(Int, a)] -> Value)
-> [(Int, a)]
-> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON ((a -> Bool) -> (Int, a) -> Bool
forall a. (a -> Bool) -> (Int, a) -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) (Int, a) -> Value
to' [(Int, a)] -> Value
tol' ([(Int, a)] -> Value)
-> (IntMap a -> [(Int, a)]) -> IntMap a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList
      where
        to' :: (Int, a) -> Value
to'  = (Int -> Bool)
-> (Int -> Value)
-> ([Int] -> Value)
-> (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (Int, a)
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> (a, b)
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2     Int -> Bool
forall a. ToJSON a => a -> Bool
omitField Int -> Value
forall a. ToJSON a => a -> Value
toJSON [Int] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList a -> Bool
o a -> Value
t [a] -> Value
tol
        tol' :: [(Int, a)] -> Value
tol' = (Int -> Bool)
-> (Int -> Value)
-> ([Int] -> Value)
-> (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> [(Int, a)]
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> [(a, b)]
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> [f a b]
-> Value
liftToJSONList2 Int -> Bool
forall a. ToJSON a => a -> Bool
omitField Int -> Value
forall a. ToJSON a => a -> Value
toJSON [Int] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList a -> Bool
o a -> Value
t [a] -> Value
tol

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> IntMap a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
t [a] -> Encoding
tol = ((Int, a) -> Bool)
-> ((Int, a) -> Encoding)
-> ([(Int, a)] -> Encoding)
-> [(Int, a)]
-> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding ((a -> Bool) -> (Int, a) -> Bool
forall a. (a -> Bool) -> (Int, a) -> Bool
forall (f :: * -> *) a. ToJSON1 f => (a -> Bool) -> f a -> Bool
liftOmitField a -> Bool
o) (Int, a) -> Encoding
to' [(Int, a)] -> Encoding
tol' ([(Int, a)] -> Encoding)
-> (IntMap a -> [(Int, a)]) -> IntMap a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList
      where
        to' :: (Int, a) -> Encoding
to'  = (Int -> Bool)
-> (Int -> Encoding)
-> ([Int] -> Encoding)
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (Int, a)
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> (a, b)
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
liftToEncoding2     Int -> Bool
forall a. ToJSON a => a -> Bool
omitField Int -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Int] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList a -> Bool
o a -> Encoding
t [a] -> Encoding
tol
        tol' :: [(Int, a)] -> Encoding
tol' = (Int -> Bool)
-> (Int -> Encoding)
-> ([Int] -> Encoding)
-> (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> [(Int, a)]
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> [(a, b)]
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> [f a b]
-> Encoding
liftToEncodingList2 Int -> Bool
forall a. ToJSON a => a -> Bool
omitField Int -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [Int] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList a -> Bool
o a -> Encoding
t [a] -> Encoding
tol

instance ToJSON a => ToJSON (IntMap.IntMap a) where
    toJSON :: IntMap a -> Value
toJSON = IntMap a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: IntMap a -> Encoding
toEncoding = IntMap a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1


instance ToJSONKey k => ToJSON1 (M.Map k) where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Map k a -> Value
liftToJSON a -> Bool
_ a -> Value
g [a] -> Value
_ = case ToJSONKeyFunction k
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey of
        ToJSONKeyText k -> Key
f k -> Encoding' Key
_ -> Object -> Value
Object (Object -> Value) -> (Map k a -> Object) -> Map k a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Key Value -> Object
forall v. Map Key v -> KeyMap v
KM.fromMap (Map Key Value -> Object)
-> (Map k a -> Map Key Value) -> Map k a -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Key) -> (a -> Value) -> Map k a -> Map Key Value
forall k2 k1 v1 v2.
Ord k2 =>
(k1 -> k2) -> (v1 -> v2) -> Map k1 v1 -> Map k2 v2
mapKeyValO k -> Key
f a -> Value
g
        ToJSONKeyValue  k -> Value
f k -> Encoding
_ -> Array -> Value
Array (Array -> Value) -> (Map k a -> Array) -> Map k a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> (Map k a -> [Value]) -> Map k a -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> Value) -> [(k, a)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((k -> Value) -> (a -> Value) -> (k, a) -> Value
forall a b. (a -> Value) -> (b -> Value) -> (a, b) -> Value
toJSONPair k -> Value
f a -> Value
g) ([(k, a)] -> [Value])
-> (Map k a -> [(k, a)]) -> Map k a -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Map k a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
g [a] -> Encoding
_ = case ToJSONKeyFunction k
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey of
        ToJSONKeyText k -> Key
_ k -> Encoding' Key
f -> (k -> Encoding' Key)
-> (a -> Encoding)
-> (forall a. (k -> a -> a -> a) -> a -> Map k a -> a)
-> Map k a
-> Encoding
forall k v m.
(k -> Encoding' Key)
-> (v -> Encoding)
-> (forall a. (k -> v -> a -> a) -> a -> m -> a)
-> m
-> Encoding
dict k -> Encoding' Key
f a -> Encoding
g (k -> a -> a -> a) -> a -> Map k a -> a
forall a. (k -> a -> a -> a) -> a -> Map k a -> a
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey
        ToJSONKeyValue k -> Value
_ k -> Encoding
f -> ((k, a) -> Encoding) -> [(k, a)] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding ((k -> Encoding) -> (k, a) -> Encoding
pairEncoding k -> Encoding
f) ([(k, a)] -> Encoding)
-> (Map k a -> [(k, a)]) -> Map k a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList
      where
        pairEncoding :: (k -> Encoding) -> (k, a) -> Encoding
pairEncoding k -> Encoding
f (k
a, a
b) = (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
E.list Encoding -> Encoding
forall a. a -> a
id [k -> Encoding
f k
a, a -> Encoding
g a
b]


instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
    toJSON :: Map k v -> Value
toJSON = Map k v -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Map k v -> Encoding
toEncoding = Map k v -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1


instance ToJSON1 Tree.Tree where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Tree a -> Value
liftToJSON a -> Bool
o a -> Value
t [a] -> Value
tol = Tree a -> Value
go
      where
        go :: Tree a -> Value
go (Tree.Node a
root [Tree a]
branches) =
            (a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> ([Tree a] -> Bool)
-> ([Tree a] -> Value)
-> ([[Tree a]] -> Value)
-> (a, [Tree a])
-> Value
forall a b.
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> (a, b)
-> Value
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Value)
-> ([a] -> Value)
-> (b -> Bool)
-> (b -> Value)
-> ([b] -> Value)
-> f a b
-> Value
liftToJSON2 a -> Bool
o a -> Value
t [a] -> Value
tol (Bool -> [Tree a] -> Bool
forall a b. a -> b -> a
const Bool
False) [Tree a] -> Value
to' [[Tree a]] -> Value
tol' (a
root, [Tree a]
branches)

        to' :: [Tree a] -> Value
to' = (Tree a -> Bool)
-> (Tree a -> Value) -> ([Tree a] -> Value) -> [Tree a] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [a] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON (Bool -> Tree a -> Bool
forall a b. a -> b -> a
const Bool
False) Tree a -> Value
go ((Tree a -> Value) -> [Tree a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue Tree a -> Value
go)
        tol' :: [[Tree a]] -> Value
tol' = (Tree a -> Bool)
-> (Tree a -> Value) -> ([Tree a] -> Value) -> [[Tree a]] -> Value
forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [[a]] -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> [f a] -> Value
liftToJSONList (Bool -> Tree a -> Bool
forall a b. a -> b -> a
const Bool
False) Tree a -> Value
go ((Tree a -> Value) -> [Tree a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue Tree a -> Value
go)

    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Tree a -> Encoding
liftToEncoding a -> Bool
o a -> Encoding
t [a] -> Encoding
tol = Tree a -> Encoding
go
      where
        go :: Tree a -> Encoding
go (Tree.Node a
root [Tree a]
branches) =
            (a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> ([Tree a] -> Bool)
-> ([Tree a] -> Encoding)
-> ([[Tree a]] -> Encoding)
-> (a, [Tree a])
-> Encoding
forall a b.
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> (a, b)
-> Encoding
forall (f :: * -> * -> *) a b.
ToJSON2 f =>
(a -> Bool)
-> (a -> Encoding)
-> ([a] -> Encoding)
-> (b -> Bool)
-> (b -> Encoding)
-> ([b] -> Encoding)
-> f a b
-> Encoding
liftToEncoding2 a -> Bool
o a -> Encoding
t [a] -> Encoding
tol (Bool -> [Tree a] -> Bool
forall a b. a -> b -> a
const Bool
False) [Tree a] -> Encoding
to' [[Tree a]] -> Encoding
tol' (a
root, [Tree a]
branches)

        to' :: [Tree a] -> Encoding
to' = (Tree a -> Bool)
-> (Tree a -> Encoding)
-> ([Tree a] -> Encoding)
-> [Tree a]
-> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [a] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding (Bool -> Tree a -> Bool
forall a b. a -> b -> a
const Bool
False) Tree a -> Encoding
go ((Tree a -> Encoding) -> [Tree a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding Tree a -> Encoding
go)
        tol' :: [[Tree a]] -> Encoding
tol' = (Tree a -> Bool)
-> (Tree a -> Encoding)
-> ([Tree a] -> Encoding)
-> [[Tree a]]
-> Encoding
forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [[a]] -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> [f a] -> Encoding
liftToEncodingList (Bool -> Tree a -> Bool
forall a b. a -> b -> a
const Bool
False) Tree a -> Encoding
go ((Tree a -> Encoding) -> [Tree a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding Tree a -> Encoding
go)

instance (ToJSON v) => ToJSON (Tree.Tree v) where
    toJSON :: Tree v -> Value
toJSON = Tree v -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Tree v -> Encoding
toEncoding = Tree v -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

-------------------------------------------------------------------------------
-- uuid
-------------------------------------------------------------------------------

instance ToJSON UUID.UUID where
    toJSON :: UUID -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (UUID -> Text) -> UUID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText
    toEncoding :: UUID -> Encoding
toEncoding = Builder -> Encoding
forall a. Builder -> Encoding' a
E.unsafeToEncoding (Builder -> Encoding) -> (UUID -> Builder) -> UUID -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
EB.quote (Builder -> Builder) -> (UUID -> Builder) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
B.byteString (ByteString -> Builder) -> (UUID -> ByteString) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes

instance ToJSONKey UUID.UUID where
    toJSONKey :: ToJSONKeyFunction UUID
toJSONKey = (UUID -> Key) -> (UUID -> Encoding' Key) -> ToJSONKeyFunction UUID
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText (Text -> Key
Key.fromText (Text -> Key) -> (UUID -> Text) -> UUID -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText) ((UUID -> Encoding' Key) -> ToJSONKeyFunction UUID)
-> (UUID -> Encoding' Key) -> ToJSONKeyFunction UUID
forall a b. (a -> b) -> a -> b
$
        Builder -> Encoding' Key
forall a. Builder -> Encoding' a
E.unsafeToEncoding (Builder -> Encoding' Key)
-> (UUID -> Builder) -> UUID -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
EB.quote (Builder -> Builder) -> (UUID -> Builder) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
B.byteString (ByteString -> Builder) -> (UUID -> ByteString) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes

-------------------------------------------------------------------------------
-- vector
-------------------------------------------------------------------------------

instance ToJSON1 Vector where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> Vector a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = Array -> Value
Array (Array -> Value) -> (Vector a -> Array) -> Vector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Vector a -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Value
t
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> Vector a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ =  (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t ([a] -> Encoding) -> (Vector a -> [a]) -> Vector a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList

instance (ToJSON a) => ToJSON (Vector a) where
    {-# SPECIALIZE instance ToJSON Array #-}

    toJSON :: Vector a -> Value
toJSON = Vector a -> Value
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: Vector a -> Encoding
toEncoding = Vector a -> Encoding
forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding
encodeVector :: forall a (v :: * -> *). (ToJSON a, Vector v a) => v a -> Encoding
encodeVector = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([a] -> Encoding) -> (v a -> [a]) -> v a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList
{-# INLINE encodeVector #-}

vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value
vectorToJSON :: forall (v :: * -> *) a. (Vector v a, ToJSON a) => v a -> Value
vectorToJSON = Array -> Value
Array (Array -> Value) -> (v a -> Array) -> v a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Vector a -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Value
forall a. ToJSON a => a -> Value
toJSON (Vector a -> Array) -> (v a -> Vector a) -> v a -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert
{-# INLINE vectorToJSON #-}

instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where
    toJSON :: Vector a -> Value
toJSON = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJSON a) => v a -> Value
vectorToJSON
    toEncoding :: Vector a -> Encoding
toEncoding = Vector a -> Encoding
forall a (v :: * -> *). (ToJSON a, Vector v a) => v a -> Encoding
encodeVector


instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where
    toJSON :: Vector a -> Value
toJSON = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJSON a) => v a -> Value
vectorToJSON
    toEncoding :: Vector a -> Encoding
toEncoding = Vector a -> Encoding
forall a (v :: * -> *). (ToJSON a, Vector v a) => v a -> Encoding
encodeVector


instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where
    toJSON :: Vector a -> Value
toJSON = Vector a -> Value
forall (v :: * -> *) a. (Vector v a, ToJSON a) => v a -> Value
vectorToJSON
    toEncoding :: Vector a -> Encoding
toEncoding = Vector a -> Encoding
forall a (v :: * -> *). (ToJSON a, Vector v a) => v a -> Encoding
encodeVector

-------------------------------------------------------------------------------
-- unordered-containers
-------------------------------------------------------------------------------

instance ToJSON1 HashSet.HashSet where
    liftToJSON :: forall a.
(a -> Bool) -> (a -> Value) -> ([a] -> Value) -> HashSet a -> Value
liftToJSON a -> Bool
_ a -> Value
t [a] -> Value
_ = (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
t ([a] -> Value) -> (HashSet a -> [a]) -> HashSet a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> [a]
forall a. HashSet a -> [a]
HashSet.toList
    liftToEncoding :: forall a.
(a -> Bool)
-> (a -> Encoding) -> ([a] -> Encoding) -> HashSet a -> Encoding
liftToEncoding a -> Bool
_ a -> Encoding
t [a] -> Encoding
_ = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
t