{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Telegram.Bot.API.Types.ChatBoostSource where
import Data.Aeson (FromJSON (..), ToJSON (..), KeyValue ((.=)), Value (..), withObject, (.:), (.:?))
import Data.Aeson.Types (Parser)
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified Data.Text as Text
import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.User
data ChatBoostSource
= ChatBoostSourcePremium
{ ChatBoostSource -> Text
chatBoostSourcePremiumSource :: Text
, ChatBoostSource -> User
chatBoostSourcePremiumUser :: User
}
| ChatBoostSourceGiftCode
{ ChatBoostSource -> Text
chatBoostSourceGiftCodeSource :: Text
, ChatBoostSource -> User
chatBoostSourceGiftCodeUser :: User
}
| ChatBoostSourceGiveaway
{ ChatBoostSource -> Text
chatBoostSourceGiveawaySource :: Text
, ChatBoostSource -> MessageId
chatBoostSourceGiveawayGiveawayMessageId :: MessageId
, ChatBoostSource -> Maybe User
chatBoostSourceGiveawayUser :: Maybe User
, ChatBoostSource -> Maybe Bool
chatBoostSourceGiveawayIsUnclaimed :: Maybe Bool
}
deriving ((forall x. ChatBoostSource -> Rep ChatBoostSource x)
-> (forall x. Rep ChatBoostSource x -> ChatBoostSource)
-> Generic ChatBoostSource
forall x. Rep ChatBoostSource x -> ChatBoostSource
forall x. ChatBoostSource -> Rep ChatBoostSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChatBoostSource -> Rep ChatBoostSource x
from :: forall x. ChatBoostSource -> Rep ChatBoostSource x
$cto :: forall x. Rep ChatBoostSource x -> ChatBoostSource
to :: forall x. Rep ChatBoostSource x -> ChatBoostSource
Generic, Int -> ChatBoostSource -> ShowS
[ChatBoostSource] -> ShowS
ChatBoostSource -> String
(Int -> ChatBoostSource -> ShowS)
-> (ChatBoostSource -> String)
-> ([ChatBoostSource] -> ShowS)
-> Show ChatBoostSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChatBoostSource -> ShowS
showsPrec :: Int -> ChatBoostSource -> ShowS
$cshow :: ChatBoostSource -> String
show :: ChatBoostSource -> String
$cshowList :: [ChatBoostSource] -> ShowS
showList :: [ChatBoostSource] -> ShowS
Show)
instance ToJSON ChatBoostSource where
toJSON :: ChatBoostSource -> Value
toJSON = \case
ChatBoostSourcePremium Text
_s User
u -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
[Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"premium" :: Text), Key
"user" Key -> User -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= User
u]
ChatBoostSourceGiftCode Text
_s User
u -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
[Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"gift_code" :: Text), Key
"user" Key -> User -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= User
u]
ChatBoostSourceGiveaway Text
_s MessageId
gm Maybe User
u Maybe Bool
iu -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty)
[ Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"giveaway" :: Text)
, Key
"giveaway_message_id" Key -> MessageId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageId
gm
, Key
"user" Key -> Maybe User -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe User
u
, Key
"is_unclaimed" Key -> Maybe Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
iu
]
instance FromJSON ChatBoostSource where
parseJSON :: Value -> Parser ChatBoostSource
parseJSON = String
-> (Object -> Parser ChatBoostSource)
-> Value
-> Parser ChatBoostSource
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ChatBoostSource" \Object
o ->
(Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source" :: Parser Text) Parser Text
-> (Text -> Parser ChatBoostSource) -> Parser ChatBoostSource
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Text
"premium" -> Text -> User -> ChatBoostSource
ChatBoostSourcePremium
(Text -> User -> ChatBoostSource)
-> Parser Text -> Parser (User -> ChatBoostSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
Parser (User -> ChatBoostSource)
-> Parser User -> Parser ChatBoostSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
Text
"gift_code" -> Text -> User -> ChatBoostSource
ChatBoostSourceGiftCode
(Text -> User -> ChatBoostSource)
-> Parser Text -> Parser (User -> ChatBoostSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
Parser (User -> ChatBoostSource)
-> Parser User -> Parser ChatBoostSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
Text
"giveaway" -> Text -> MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource
ChatBoostSourceGiveaway
(Text -> MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource)
-> Parser Text
-> Parser
(MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
Parser (MessageId -> Maybe User -> Maybe Bool -> ChatBoostSource)
-> Parser MessageId
-> Parser (Maybe User -> Maybe Bool -> ChatBoostSource)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser MessageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"giveaway_message_id"
Parser (Maybe User -> Maybe Bool -> ChatBoostSource)
-> Parser (Maybe User) -> Parser (Maybe Bool -> ChatBoostSource)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
Parser (Maybe Bool -> ChatBoostSource)
-> Parser (Maybe Bool) -> Parser ChatBoostSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_unclaimed"
Text
t -> String -> Parser ChatBoostSource
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ChatBoostSource)
-> String -> Parser ChatBoostSource
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text
"Unknown source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)