{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Telegram.Bot.API.Types.ReactionType where
import Data.Aeson (FromJSON (..), ToJSON (..), KeyValue ((.=)), Value (..), withObject, (.:))
import Data.Aeson.Types (Parser)
import Data.Text (Text)
import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Internal.Utils
import qualified Data.Text as Text
data ReactionType
= ReactionTypeEmoji
{ ReactionType -> Text
reactionTypeEmojiType :: Text
, ReactionType -> Text
reactionTypeEmojiEmoji :: Text
}
| ReactionTypeCustomEmoji
{ ReactionType -> Text
reactionTypeCustomEmojiType :: Text
, ReactionType -> Text
reactionTypeCustomEmojiCustomEmojiId :: Text
}
deriving Int -> ReactionType -> ShowS
[ReactionType] -> ShowS
ReactionType -> String
(Int -> ReactionType -> ShowS)
-> (ReactionType -> String)
-> ([ReactionType] -> ShowS)
-> Show ReactionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReactionType -> ShowS
showsPrec :: Int -> ReactionType -> ShowS
$cshow :: ReactionType -> String
show :: ReactionType -> String
$cshowList :: [ReactionType] -> ShowS
showList :: [ReactionType] -> ShowS
Show
instance ToJSON ReactionType where
toJSON :: ReactionType -> Value
toJSON = \case
ReactionTypeEmoji Text
_t Text
e -> Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty) (Text -> [Pair] -> [Pair]
addType Text
"emoji" [Key
"emoji" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
e])
ReactionTypeCustomEmoji Text
_t Text
cei ->
Value -> [Pair] -> Value
addJsonFields (Object -> Value
Object Object
forall a. Monoid a => a
mempty) (Text -> [Pair] -> [Pair]
addType Text
"custom_emoji" [Key
"custom_emoji_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cei])
instance FromJSON ReactionType where
parseJSON :: Value -> Parser ReactionType
parseJSON = String
-> (Object -> Parser ReactionType) -> Value -> Parser ReactionType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReactionType" \Object
o ->
(Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Text) Parser Text -> (Text -> Parser ReactionType) -> Parser ReactionType
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
"emoji" -> Text -> Text -> ReactionType
ReactionTypeEmoji
(Text -> Text -> ReactionType)
-> Parser Text -> Parser (Text -> ReactionType)
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
"type"
Parser (Text -> ReactionType) -> Parser Text -> Parser ReactionType
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emoji"
Text
"custom_emoji" -> Text -> Text -> ReactionType
ReactionTypeCustomEmoji
(Text -> Text -> ReactionType)
-> Parser Text -> Parser (Text -> ReactionType)
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
"type"
Parser (Text -> ReactionType) -> Parser Text -> Parser ReactionType
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_emoji_id"
Text
t -> String -> Parser ReactionType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ReactionType) -> String -> Parser ReactionType
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text
"Unknown type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)