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

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

import Telegram.Bot.API.Types.User
import Telegram.Bot.API.Internal.Utils

-- ** MessageEntity

-- | This object represents one special entity in a text message. For example, hashtags, usernames, URLs, etc.
data MessageEntity = MessageEntity
  { MessageEntity -> MessageEntityType
messageEntityType   :: MessageEntityType -- ^ Type of the entity. Can be mention (@username), hashtag, bot_command, url, email, bold (bold text), italic (italic text), underline (underlined text), strikethrough, code (monowidth string), pre (monowidth block), text_link (for clickable text URLs), text_mention (for users without usernames)
  , MessageEntity -> Int
messageEntityOffset :: Int -- ^ Offset in UTF-16 code units to the start of the entity
  , MessageEntity -> Int
messageEntityLength :: Int -- ^ Length of the entity in UTF-16 code units
  , MessageEntity -> Maybe Text
messageEntityUrl    :: Maybe Text -- ^ For “text_link” only, url that will be opened after user taps on the text
  , MessageEntity -> Maybe User
messageEntityUser   :: Maybe User -- ^ For “text_mention” only, the mentioned user
  , MessageEntity -> Maybe Text
messageEntityLanguage :: Maybe Text -- ^ For “pre” only, the programming language of the entity text.
  , MessageEntity -> Maybe Text
messageEntityCustomEmojiId :: Maybe Text -- ^ For “custom_emoji” only, unique identifier of the custom emoji. Use @getCustomEmojiStickers@ to get full information about the sticker.
  }
  deriving ((forall x. MessageEntity -> Rep MessageEntity x)
-> (forall x. Rep MessageEntity x -> MessageEntity)
-> Generic MessageEntity
forall x. Rep MessageEntity x -> MessageEntity
forall x. MessageEntity -> Rep MessageEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageEntity -> Rep MessageEntity x
from :: forall x. MessageEntity -> Rep MessageEntity x
$cto :: forall x. Rep MessageEntity x -> MessageEntity
to :: forall x. Rep MessageEntity x -> MessageEntity
Generic, Int -> MessageEntity -> ShowS
[MessageEntity] -> ShowS
MessageEntity -> String
(Int -> MessageEntity -> ShowS)
-> (MessageEntity -> String)
-> ([MessageEntity] -> ShowS)
-> Show MessageEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageEntity -> ShowS
showsPrec :: Int -> MessageEntity -> ShowS
$cshow :: MessageEntity -> String
show :: MessageEntity -> String
$cshowList :: [MessageEntity] -> ShowS
showList :: [MessageEntity] -> ShowS
Show)

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


-- | Type of the entity. Can be mention (@username), hashtag, bot_command, url, email, bold (bold text), italic (italic text), underline (underlined text), strikethrough, code (monowidth string), pre (monowidth block), text_link (for clickable text URLs), text_mention (for users without usernames), cashtag, phone_number
data MessageEntityType
  = MessageEntityMention
  | MessageEntityHashtag
  | MessageEntityBotCommand
  | MessageEntityUrl
  | MessageEntityEmail
  | MessageEntityBold
  | MessageEntityItalic
  | MessageEntityUnderline -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_underline.html>
  | MessageEntityStrikethrough -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_strikethrough.html>
  | MessageEntityCode
  | MessageEntityPre
  | MessageEntityTextLink
  | MessageEntityTextMention
  | MessageEntityCashtag -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_cashtag.html>.
  | MessageEntityPhoneNumber -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_phone_number.html>.
  | MessageEntitySpoiler
  | MessageEntityCustomEmoji
  deriving (MessageEntityType -> MessageEntityType -> Bool
(MessageEntityType -> MessageEntityType -> Bool)
-> (MessageEntityType -> MessageEntityType -> Bool)
-> Eq MessageEntityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageEntityType -> MessageEntityType -> Bool
== :: MessageEntityType -> MessageEntityType -> Bool
$c/= :: MessageEntityType -> MessageEntityType -> Bool
/= :: MessageEntityType -> MessageEntityType -> Bool
Eq, Int -> MessageEntityType -> ShowS
[MessageEntityType] -> ShowS
MessageEntityType -> String
(Int -> MessageEntityType -> ShowS)
-> (MessageEntityType -> String)
-> ([MessageEntityType] -> ShowS)
-> Show MessageEntityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageEntityType -> ShowS
showsPrec :: Int -> MessageEntityType -> ShowS
$cshow :: MessageEntityType -> String
show :: MessageEntityType -> String
$cshowList :: [MessageEntityType] -> ShowS
showList :: [MessageEntityType] -> ShowS
Show, (forall x. MessageEntityType -> Rep MessageEntityType x)
-> (forall x. Rep MessageEntityType x -> MessageEntityType)
-> Generic MessageEntityType
forall x. Rep MessageEntityType x -> MessageEntityType
forall x. MessageEntityType -> Rep MessageEntityType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageEntityType -> Rep MessageEntityType x
from :: forall x. MessageEntityType -> Rep MessageEntityType x
$cto :: forall x. Rep MessageEntityType x -> MessageEntityType
to :: forall x. Rep MessageEntityType x -> MessageEntityType
Generic)

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