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

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Text (Text)
import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic)

import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.MessageEntity
import Telegram.Bot.API.Types.PollOption
import Telegram.Bot.API.Types.PollType
import Telegram.Bot.API.Internal.Utils

-- ** 'Poll'

data Poll = Poll
  { Poll -> PollId
pollId                    :: PollId                -- ^ Unique poll identifier.
  , Poll -> Text
pollQuestion              :: Text                  -- ^ Poll question, 1-300 characters.
  , Poll -> [PollOption]
pollOptions               :: [PollOption]          -- ^ List of poll options.
  , Poll -> Int
pollTotalVoterCount       :: Int                 -- ^ Total number of users that voted in the poll.
  , Poll -> Bool
pollIsClosed              :: Bool                  -- ^ 'True', if the poll is closed.
  , Poll -> Bool
pollIsAnonymous           :: Bool                  -- ^ 'True', if the poll is anonymous.
  , Poll -> PollType
pollType                  :: PollType              -- ^ Poll type, currently can be “regular” or “quiz”.
  , Poll -> Bool
pollAllowsMultipleAnswers :: Bool                  -- ^ 'True', if the poll allows multiple answers.
  , Poll -> Maybe Int
pollCorrectOptionId       :: Maybe Int             -- ^ 0-based identifier of the correct answer option. Available only for polls in the quiz mode, which are closed, or was sent (not forwarded) by the bot or to the private chat with the bot.
  , Poll -> Maybe Text
pollExplanation           :: 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.
  , Poll -> Maybe [MessageEntity]
pollExplanationEntities   :: Maybe [MessageEntity] -- ^ Special entities like usernames, URLs, bot commands, etc. that appear in the explanation.
  , Poll -> Maybe Seconds
pollOpenPeriod            :: Maybe Seconds         -- ^ Amount of time in seconds the poll will be active after creation.
  , Poll -> Maybe POSIXTime
pollCloseData             :: Maybe POSIXTime       -- ^ Point in time (Unix timestamp) when the poll will be automatically closed.
  }
  deriving (forall x. Rep Poll x -> Poll
forall x. Poll -> Rep Poll x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Poll x -> Poll
$cfrom :: forall x. Poll -> Rep Poll x
Generic, Int -> Poll -> ShowS
[Poll] -> ShowS
Poll -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Poll] -> ShowS
$cshowList :: [Poll] -> ShowS
show :: Poll -> String
$cshow :: Poll -> String
showsPrec :: Int -> Poll -> ShowS
$cshowsPrec :: Int -> Poll -> ShowS
Show)

instance ToJSON   Poll where toJSON :: Poll -> 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 Poll where parseJSON :: Value -> Parser Poll
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON