{-# 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

-- ** 'ReactionType'

-- | This object describes the type of a reaction. Currently, it can be one of
--
-- * 'ReactionTypeEmoji',
-- * 'ReactionTypeCustomEmoji'.
--
data ReactionType
  -- ^ The reaction is based on an emoji.
  = ReactionTypeEmoji
      { ReactionType -> Text
reactionTypeEmojiType  :: Text -- ^ Type of the reaction, always “emoji”.
      , ReactionType -> Text
reactionTypeEmojiEmoji :: Text -- ^ Reaction emoji. Currently, it can be one of "👍", "👎", "❤", "🔥", "🥰", "👏", "😁", "🤔", "🤯", "😱", "🤬", "😢", "🎉", "🤩", "🤮", "💩", "🙏", "👌", "🕊", "🤡", "🥱", "🥴", "😍", "🐳", "❤‍🔥", "🌚", "🌭", "💯", "🤣", "⚡", "🍌", "🏆", "💔", "🤨", "😐", "🍓", "🍾", "💋", "🖕", "😈", "😴", "😭", "🤓", "👻", "👨‍💻", "👀", "🎃", "🙈", "😇", "😨", "🤝", "✍", "🤗", "🫡", "🎅", "🎄", "☃", "💅", "🤪", "🗿", "🆒", "💘", "🙉", "🦄", "😘", "💊", "🙊", "😎", "👾", "🤷‍♂", "🤷", "🤷‍♀", "😡".
      }
  -- ^ The reaction is based on a custom emoji.
  | ReactionTypeCustomEmoji
      { ReactionType -> Text
reactionTypeCustomEmojiType :: Text -- ^ Type of the reaction, always “custom_emoji”.
      , ReactionType -> Text
reactionTypeCustomEmojiCustomEmojiId :: Text -- ^ Custom emoji identifier.
      }
  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)