{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.SendPoll where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
import Data.Text
import GHC.Generics (Generic)
import Servant.API
import Servant.Client hiding (Response)

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types
import Telegram.Bot.API.Types.ParseMode
import Telegram.Bot.API.Internal.TH

-- ** 'sendPoll'

-- | Request parameters for 'sendPoll'.
data SendPollRequest = SendPollRequest
  { SendPollRequest -> SomeChatId
sendPollChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , SendPollRequest -> Maybe MessageThreadId
sendPollMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendPollRequest -> Text
sendPollQuestion :: Text -- ^ Poll question, 1-300 characters
  , SendPollRequest -> [Text]
sendPollOptions :: [Text] -- ^ A JSON-serialized list of answer options, 2-10 strings 1-100 characters each
  , SendPollRequest -> Maybe Bool
sendPollIsAnonymous :: Maybe Bool -- ^ True, if the poll needs to be anonymous, defaults to True
  , SendPollRequest -> Maybe Text
sendPollType :: Maybe Text -- ^ Poll type, “quiz” or “regular”, defaults to “regular”
  , SendPollRequest -> Maybe Bool
sendPollAllowsMultipleAnswers :: Maybe Bool -- ^ True, if the poll allows multiple answers, ignored for polls in quiz mode, defaults to False
  , SendPollRequest -> Maybe Int
sendPollCorrectOptionId :: Maybe Int -- ^ 0-based identifier of the correct answer option, required for polls in quiz mode
  , SendPollRequest -> Maybe Text
sendPollExplanation :: Maybe Text -- ^ Text that is shown when a user chooses an incorrect answer or taps on the lamp icon in a quiz-style poll, 0-200 characters with at most 2 line feeds after entities parsing
  , SendPollRequest -> Maybe ParseMode
sendPollExplanationParseMode :: Maybe ParseMode  -- ^ Send 'MarkdownV2', 'HTML' or 'Markdown' (legacy), if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.
  , SendPollRequest -> Maybe [MessageEntity]
sendPollExplanationEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the poll explanation, which can be specified instead of parse_mode
  , SendPollRequest -> Maybe Int
sendPollOpenPeriod :: Maybe Int -- ^ Amount of time in seconds the poll will be active after creation, 5-600. Can't be used together with close_date.
  , SendPollRequest -> Maybe Int
sendPollCloseDate :: Maybe Int -- ^ Point in time (Unix timestamp) when the poll will be automatically closed. Must be at least 5 and no more than 600 seconds in the future. Can't be used together with open_period.
  , SendPollRequest -> Maybe Bool
sendPollIsClosed :: Maybe Bool -- ^ Pass True, if the poll needs to be immediately closed. This can be useful for poll preview.
  , SendPollRequest -> Maybe Bool
sendPollDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendPollRequest -> Maybe Bool
sendPollProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving
  , SendPollRequest -> Maybe MessageId
sendPollReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , SendPollRequest -> Maybe ReplyParameters
sendPollReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , SendPollRequest -> Maybe InlineKeyboardMarkup
sendPollReplyMarkup :: Maybe InlineKeyboardMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user.
  }
  deriving (forall x. SendPollRequest -> Rep SendPollRequest x)
-> (forall x. Rep SendPollRequest x -> SendPollRequest)
-> Generic SendPollRequest
forall x. Rep SendPollRequest x -> SendPollRequest
forall x. SendPollRequest -> Rep SendPollRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendPollRequest -> Rep SendPollRequest x
from :: forall x. SendPollRequest -> Rep SendPollRequest x
$cto :: forall x. Rep SendPollRequest x -> SendPollRequest
to :: forall x. Rep SendPollRequest x -> SendPollRequest
Generic

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

type SendPoll = "sendPoll"
  :> ReqBody '[JSON] SendPollRequest
  :> Post '[JSON] (Response Message)

-- | Use this method to send a native poll.
--   On success, the sent Message is returned.
sendPoll :: SendPollRequest ->  ClientM (Response Message)
sendPoll :: SendPollRequest -> ClientM (Response Message)
sendPoll = Proxy SendPoll -> Client ClientM SendPoll
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendPoll)

makeDefault ''SendPollRequest