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

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

import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.KeyboardButtonRequestChat
import Telegram.Bot.API.Types.KeyboardButtonRequestUser
import Telegram.Bot.API.Types.PollType
import Telegram.Bot.API.Internal.Utils

-- ** 'KeyboardButton'

-- | This object represents one button of the reply keyboard.
-- For simple text buttons String can be used instead of this object
-- to specify text of the button. Optional fields are mutually exclusive.
data KeyboardButton = KeyboardButton
  { KeyboardButton -> Text
keyboardButtonText            :: Text       -- ^ Text of the button. If none of the optional fields are used, it will be sent as a message when the button is pressed.
  , KeyboardButton -> Maybe KeyboardButtonRequestUser
keyboardButtonRequestUser     :: Maybe KeyboardButtonRequestUser -- ^ If specified, pressing the button will open a list of suitable users. Tapping on any user will send their identifier to the bot in a “user_shared” service message. Available in private chats only.
  , KeyboardButton -> Maybe KeyboardButtonRequestChat
keyboardButtonRequestChat     :: Maybe KeyboardButtonRequestChat -- ^ If specified, pressing the button will open a list of suitable chats. Tapping on a chat will send its identifier to the bot in a “chat_shared” service message. Available in private chats only.
  , KeyboardButton -> Maybe Bool
keyboardButtonRequestContact  :: Maybe Bool -- ^ If 'True', the user's phone number will be sent as a contact when the button is pressed. Available in private chats only.
  , KeyboardButton -> Maybe Bool
keyboardButtonRequestLocation :: Maybe Bool -- ^ If 'True', the user's current location will be sent when the button is pressed. Available in private chats only.
  , KeyboardButton -> Maybe PollType
keyboardButtonRequestPoll     :: Maybe PollType -- ^ If specified, the user will be asked to create a poll and send it to the bot when the button is pressed. Available in private chats only.
  , KeyboardButton -> Maybe WebAppInfo
keyboardButtonWebApp          :: Maybe WebAppInfo -- ^ If specified, the described Web App will be launched when the button is pressed. The Web App will be able to send a “web_app_data” service message. Available in private chats only.
  }
  deriving (forall x. Rep KeyboardButton x -> KeyboardButton
forall x. KeyboardButton -> Rep KeyboardButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyboardButton x -> KeyboardButton
$cfrom :: forall x. KeyboardButton -> Rep KeyboardButton x
Generic, Int -> KeyboardButton -> ShowS
[KeyboardButton] -> ShowS
KeyboardButton -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyboardButton] -> ShowS
$cshowList :: [KeyboardButton] -> ShowS
show :: KeyboardButton -> String
$cshow :: KeyboardButton -> String
showsPrec :: Int -> KeyboardButton -> ShowS
$cshowsPrec :: Int -> KeyboardButton -> ShowS
Show)

instance IsString KeyboardButton where
  fromString :: String -> KeyboardButton
fromString String
s = Text
-> Maybe KeyboardButtonRequestUser
-> Maybe KeyboardButtonRequestChat
-> Maybe Bool
-> Maybe Bool
-> Maybe PollType
-> Maybe WebAppInfo
-> KeyboardButton
KeyboardButton (forall a. IsString a => String -> a
fromString String
s) 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   KeyboardButton where toJSON :: KeyboardButton -> 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 KeyboardButton where parseJSON :: Value -> Parser KeyboardButton
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON