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

import Data.Aeson
import GHC.Generics (Generic)

import Telegram.Bot.API.Internal.Utils

-- ** 'VideoChatStarted'

-- | This object represents a service message about a video chat started in the chat. Currently holds no information.
data VideoChatStarted = VideoChatStarted
  deriving (forall x. Rep VideoChatStarted x -> VideoChatStarted
forall x. VideoChatStarted -> Rep VideoChatStarted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VideoChatStarted x -> VideoChatStarted
$cfrom :: forall x. VideoChatStarted -> Rep VideoChatStarted x
Generic, Int -> VideoChatStarted -> ShowS
[VideoChatStarted] -> ShowS
VideoChatStarted -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoChatStarted] -> ShowS
$cshowList :: [VideoChatStarted] -> ShowS
show :: VideoChatStarted -> String
$cshow :: VideoChatStarted -> String
showsPrec :: Int -> VideoChatStarted -> ShowS
$cshowsPrec :: Int -> VideoChatStarted -> ShowS
Show)

instance ToJSON VideoChatStarted where
  toJSON :: VideoChatStarted -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

instance FromJSON VideoChatStarted where
  parseJSON :: Value -> Parser VideoChatStarted
parseJSON (Object Object
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure VideoChatStarted
VideoChatStarted
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse VideoChatStarted: expected an empty object"