{-# LANGUAGE DeriveGeneric #-}
module Telegram.Bot.API.Types.ChatBoostUpdated where

import Data.Aeson (FromJSON (..), ToJSON (..))
import GHC.Generics (Generic)

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.Types.Chat
import Telegram.Bot.API.Types.ChatBoost

-- ** 'ChatBoostUpdated'

-- | This object represents a boost added to a chat or changed.
data ChatBoostUpdated = ChatBoostUpdated
  { ChatBoostUpdated -> Chat
chatBoostUpdatedChat :: Chat -- ^ Chat which was boosted.
  , ChatBoostUpdated -> ChatBoost
chatBoostUpdatedBoost :: ChatBoost -- ^ Infomation about the chat boost.
  }
  deriving ((forall x. ChatBoostUpdated -> Rep ChatBoostUpdated x)
-> (forall x. Rep ChatBoostUpdated x -> ChatBoostUpdated)
-> Generic ChatBoostUpdated
forall x. Rep ChatBoostUpdated x -> ChatBoostUpdated
forall x. ChatBoostUpdated -> Rep ChatBoostUpdated x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChatBoostUpdated -> Rep ChatBoostUpdated x
from :: forall x. ChatBoostUpdated -> Rep ChatBoostUpdated x
$cto :: forall x. Rep ChatBoostUpdated x -> ChatBoostUpdated
to :: forall x. Rep ChatBoostUpdated x -> ChatBoostUpdated
Generic, Int -> ChatBoostUpdated -> ShowS
[ChatBoostUpdated] -> ShowS
ChatBoostUpdated -> String
(Int -> ChatBoostUpdated -> ShowS)
-> (ChatBoostUpdated -> String)
-> ([ChatBoostUpdated] -> ShowS)
-> Show ChatBoostUpdated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatBoostUpdated -> ShowS
showsPrec :: Int -> ChatBoostUpdated -> ShowS
$cshow :: ChatBoostUpdated -> String
show :: ChatBoostUpdated -> String
$cshowList :: [ChatBoostUpdated] -> ShowS
showList :: [ChatBoostUpdated] -> ShowS
Show)

instance ToJSON   ChatBoostUpdated where toJSON :: ChatBoostUpdated -> Value
toJSON = ChatBoostUpdated -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON ChatBoostUpdated where parseJSON :: Value -> Parser ChatBoostUpdated
parseJSON = Value -> Parser ChatBoostUpdated
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON