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

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

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

-- ** 'TextQuote'

-- | This object contains information about the quoted part of a message that is replied to by the given message.
data TextQuote = TextQuote
  { TextQuote -> Text
textQuoteText :: Text -- ^ Text of the quoted part of a message that is replied to by the given message.
  , TextQuote -> Maybe [MessageEntity]
textQuoteEntities :: Maybe [MessageEntity] -- ^ Special entities that appear in the quote. Currently, only @bold@, @italic@, @underline@, @strikethrough@, @spoiler@, and @custom_emoji@ entities are kept in quotes.
  , TextQuote -> Int
textQuotePosition :: Int -- ^ Approximate quote position in the original message in UTF-16 code units as specified by the sender.
  , TextQuote -> Maybe Bool
textQuoteIsManual :: Maybe Bool -- ^ 'True', if the quote was chosen manually by the message sender. Otherwise, the quote was added automatically by the server.
  } deriving (Int -> TextQuote -> ShowS
[TextQuote] -> ShowS
TextQuote -> String
(Int -> TextQuote -> ShowS)
-> (TextQuote -> String)
-> ([TextQuote] -> ShowS)
-> Show TextQuote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextQuote -> ShowS
showsPrec :: Int -> TextQuote -> ShowS
$cshow :: TextQuote -> String
show :: TextQuote -> String
$cshowList :: [TextQuote] -> ShowS
showList :: [TextQuote] -> ShowS
Show, (forall x. TextQuote -> Rep TextQuote x)
-> (forall x. Rep TextQuote x -> TextQuote) -> Generic TextQuote
forall x. Rep TextQuote x -> TextQuote
forall x. TextQuote -> Rep TextQuote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextQuote -> Rep TextQuote x
from :: forall x. TextQuote -> Rep TextQuote x
$cto :: forall x. Rep TextQuote x -> TextQuote
to :: forall x. Rep TextQuote x -> TextQuote
Generic)

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