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

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

import Telegram.Bot.API.Types.CallbackGame
import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Internal.Utils

-- ** 'InlineKeyboardButton'

-- | This object represents one button of an inline keyboard. You must use exactly one of the optional fields.
data InlineKeyboardButton = InlineKeyboardButton
  { InlineKeyboardButton -> Text
inlineKeyboardButtonText              :: Text -- ^ Label text on the button
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonUrl               :: Maybe Text -- ^ HTTP url to be opened when button is pressed
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonCallbackData      :: Maybe Text -- ^ Data to be sent in a callback query to the bot when button is pressed, 1-64 bytes
  , InlineKeyboardButton -> Maybe WebAppInfo
inlineKeyboardButtonWebApp            :: Maybe WebAppInfo -- ^ Description of the Web App that will be launched when the user presses the button. The Web App will be able to send an arbitrary message on behalf of the user using the method @answerWebAppQuery@. Available only in private chats between a user and the bot.
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonSwitchInlineQuery :: Maybe Text -- ^ If set, pressing the button will prompt the user to select one of their chats, open that chat and insert the bot‘s username and the specified inline query in the input field. Can be empty, in which case just the bot’s username will be inserted.
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonSwitchInlineQueryCurrentChat :: Maybe Text -- ^ If set, pressing the button will insert the bot‘s username and the specified inline query in the current chat's input field. Can be empty, in which case only the bot’s username will be inserted.

  , InlineKeyboardButton -> Maybe CallbackGame
inlineKeyboardButtonCallbackGame      :: Maybe CallbackGame -- ^ Description of the game that will be launched when the user presses the button.
  , InlineKeyboardButton -> Maybe Bool
inlineKeyboardButtonPay               :: Maybe Bool -- ^ Specify True, to send a Pay button.
  }
  deriving (forall x. Rep InlineKeyboardButton x -> InlineKeyboardButton
forall x. InlineKeyboardButton -> Rep InlineKeyboardButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InlineKeyboardButton x -> InlineKeyboardButton
$cfrom :: forall x. InlineKeyboardButton -> Rep InlineKeyboardButton x
Generic, Int -> InlineKeyboardButton -> ShowS
[InlineKeyboardButton] -> ShowS
InlineKeyboardButton -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineKeyboardButton] -> ShowS
$cshowList :: [InlineKeyboardButton] -> ShowS
show :: InlineKeyboardButton -> String
$cshow :: InlineKeyboardButton -> String
showsPrec :: Int -> InlineKeyboardButton -> ShowS
$cshowsPrec :: Int -> InlineKeyboardButton -> ShowS
Show)

labeledInlineKeyboardButton :: Text -> InlineKeyboardButton
labeledInlineKeyboardButton :: Text -> InlineKeyboardButton
labeledInlineKeyboardButton Text
label = Text
-> Maybe Text
-> Maybe Text
-> Maybe WebAppInfo
-> Maybe Text
-> Maybe Text
-> Maybe CallbackGame
-> Maybe Bool
-> InlineKeyboardButton
InlineKeyboardButton Text
label forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

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