{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}
module Telegram.Bot.API.Games where

import Data.Text (Text)
import Data.Proxy
import GHC.Generics (Generic)
import Servant.API
import Servant.Client hiding (Response)

import Telegram.Bot.API.Internal.Utils (deriveJSON')
import Telegram.Bot.API.MakingRequests (Response)
import Telegram.Bot.API.Types
  ( ChatId, GameHighScore, InlineKeyboardMarkup, Message, MessageId, MessageThreadId
  , ReplyParameters, UserId
  )
import Telegram.Bot.API.Internal.TH

-- * Types

-- ** 'SendGameRequest'

data SendGameRequest = SendGameRequest
  { SendGameRequest -> ChatId
sendGameChatId                   :: ChatId                     -- ^ Unique identifier for the target chat.
  , SendGameRequest -> Maybe MessageThreadId
sendGameMessageThreadId          :: Maybe MessageThreadId      -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendGameRequest -> Text
sendGameGameShortName            :: Text                       -- ^ Short name of the game, serves as the unique identifier for the game. Set up your games via Botfather.
  , SendGameRequest -> Maybe Bool
sendGameDisableNotification      :: Maybe Bool                 -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendGameRequest -> Maybe Bool
sendGameProtectContent           :: Maybe Bool                 -- ^ Protects the contents of the sent message from forwarding and saving.
  , SendGameRequest -> Maybe MessageId
sendGameReplyToMessageId         :: Maybe MessageId            -- ^ If the message is a reply, ID of the original message.
  , SendGameRequest -> Maybe ReplyParameters
sendGameReplyParameters          :: Maybe ReplyParameters      -- ^ Description of the message to reply to.
  , SendGameRequest -> Maybe InlineKeyboardMarkup
sendGameReplyMarkup              :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard. If empty, one 'Play game_title' button will be shown. If not empty, the first button must launch the game.
  }
  deriving ((forall x. SendGameRequest -> Rep SendGameRequest x)
-> (forall x. Rep SendGameRequest x -> SendGameRequest)
-> Generic SendGameRequest
forall x. Rep SendGameRequest x -> SendGameRequest
forall x. SendGameRequest -> Rep SendGameRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendGameRequest -> Rep SendGameRequest x
from :: forall x. SendGameRequest -> Rep SendGameRequest x
$cto :: forall x. Rep SendGameRequest x -> SendGameRequest
to :: forall x. Rep SendGameRequest x -> SendGameRequest
Generic, Int -> SendGameRequest -> ShowS
[SendGameRequest] -> ShowS
SendGameRequest -> String
(Int -> SendGameRequest -> ShowS)
-> (SendGameRequest -> String)
-> ([SendGameRequest] -> ShowS)
-> Show SendGameRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendGameRequest -> ShowS
showsPrec :: Int -> SendGameRequest -> ShowS
$cshow :: SendGameRequest -> String
show :: SendGameRequest -> String
$cshowList :: [SendGameRequest] -> ShowS
showList :: [SendGameRequest] -> ShowS
Show)

-- ** 'SetGameScoreRequest'

data SetGameScoreRequest = SetGameScoreRequest
  { SetGameScoreRequest -> UserId
setGameScoreUserId             :: UserId          -- ^ User identifier.
  , SetGameScoreRequest -> Integer
setGameScoreScore              :: Integer         -- ^ New score, must be non-negative.
  , SetGameScoreRequest -> Maybe Bool
setGameScoreForce              :: Maybe Bool      -- ^ Pass 'True', if the high score is allowed to decrease. This can be useful when fixing mistakes or banning cheaters.
  , SetGameScoreRequest -> Maybe Bool
setGameScoreDisableEditMessage :: Maybe Bool      -- ^ Pass 'True', if the game message should not be automatically edited to include the current scoreboard.
  , SetGameScoreRequest -> Maybe ChatId
setGameScoreChatId             :: Maybe ChatId    -- ^ Required if @inline_message_id@ is not specified. Unique identifier for the target chat
  , SetGameScoreRequest -> Maybe MessageId
setGameScoreMessageId          :: Maybe MessageId -- ^ Required if @inline_message_id@ is not specified. Identifier of the sent message.
  , SetGameScoreRequest -> Maybe MessageId
setGameScoreInlineMessageId    :: Maybe MessageId -- ^ Required if @chat_id@ and @message_id@ are not specified. Identifier of the inline message.
  }
  deriving ((forall x. SetGameScoreRequest -> Rep SetGameScoreRequest x)
-> (forall x. Rep SetGameScoreRequest x -> SetGameScoreRequest)
-> Generic SetGameScoreRequest
forall x. Rep SetGameScoreRequest x -> SetGameScoreRequest
forall x. SetGameScoreRequest -> Rep SetGameScoreRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetGameScoreRequest -> Rep SetGameScoreRequest x
from :: forall x. SetGameScoreRequest -> Rep SetGameScoreRequest x
$cto :: forall x. Rep SetGameScoreRequest x -> SetGameScoreRequest
to :: forall x. Rep SetGameScoreRequest x -> SetGameScoreRequest
Generic, Int -> SetGameScoreRequest -> ShowS
[SetGameScoreRequest] -> ShowS
SetGameScoreRequest -> String
(Int -> SetGameScoreRequest -> ShowS)
-> (SetGameScoreRequest -> String)
-> ([SetGameScoreRequest] -> ShowS)
-> Show SetGameScoreRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetGameScoreRequest -> ShowS
showsPrec :: Int -> SetGameScoreRequest -> ShowS
$cshow :: SetGameScoreRequest -> String
show :: SetGameScoreRequest -> String
$cshowList :: [SetGameScoreRequest] -> ShowS
showList :: [SetGameScoreRequest] -> ShowS
Show)

-- ** 'SetGameScoreResult'

data SetGameScoreResult = SetGameScoreMessage Message | SetGameScoreMessageBool Bool
  deriving ((forall x. SetGameScoreResult -> Rep SetGameScoreResult x)
-> (forall x. Rep SetGameScoreResult x -> SetGameScoreResult)
-> Generic SetGameScoreResult
forall x. Rep SetGameScoreResult x -> SetGameScoreResult
forall x. SetGameScoreResult -> Rep SetGameScoreResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetGameScoreResult -> Rep SetGameScoreResult x
from :: forall x. SetGameScoreResult -> Rep SetGameScoreResult x
$cto :: forall x. Rep SetGameScoreResult x -> SetGameScoreResult
to :: forall x. Rep SetGameScoreResult x -> SetGameScoreResult
Generic, Int -> SetGameScoreResult -> ShowS
[SetGameScoreResult] -> ShowS
SetGameScoreResult -> String
(Int -> SetGameScoreResult -> ShowS)
-> (SetGameScoreResult -> String)
-> ([SetGameScoreResult] -> ShowS)
-> Show SetGameScoreResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetGameScoreResult -> ShowS
showsPrec :: Int -> SetGameScoreResult -> ShowS
$cshow :: SetGameScoreResult -> String
show :: SetGameScoreResult -> String
$cshowList :: [SetGameScoreResult] -> ShowS
showList :: [SetGameScoreResult] -> ShowS
Show)

-- ** 'GetGameHighScoresRequest'

data GetGameHighScoresRequest = GetGameHighScoresRequest
  { GetGameHighScoresRequest -> UserId
getGameHighScoresUserId          :: UserId          -- ^ Target user id.
  , GetGameHighScoresRequest -> Maybe ChatId
getGameHighScoresChatId          :: Maybe ChatId    -- ^ Required if @inline_message_id@ is not specified. Unique identifier for the target chat.
  , GetGameHighScoresRequest -> Maybe MessageId
getGameHighScoresMessageId       :: Maybe MessageId -- ^ Required if @inline_message_id@ is not specified. Identifier of the sent message.
  , GetGameHighScoresRequest -> Maybe MessageId
getGameHighScoresInlineMessageId :: Maybe MessageId -- ^ Required if @chat_id@ and @message_id@ are not specified. Identifier of the inline message.
  }
  deriving ((forall x.
 GetGameHighScoresRequest -> Rep GetGameHighScoresRequest x)
-> (forall x.
    Rep GetGameHighScoresRequest x -> GetGameHighScoresRequest)
-> Generic GetGameHighScoresRequest
forall x.
Rep GetGameHighScoresRequest x -> GetGameHighScoresRequest
forall x.
GetGameHighScoresRequest -> Rep GetGameHighScoresRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetGameHighScoresRequest -> Rep GetGameHighScoresRequest x
from :: forall x.
GetGameHighScoresRequest -> Rep GetGameHighScoresRequest x
$cto :: forall x.
Rep GetGameHighScoresRequest x -> GetGameHighScoresRequest
to :: forall x.
Rep GetGameHighScoresRequest x -> GetGameHighScoresRequest
Generic, Int -> GetGameHighScoresRequest -> ShowS
[GetGameHighScoresRequest] -> ShowS
GetGameHighScoresRequest -> String
(Int -> GetGameHighScoresRequest -> ShowS)
-> (GetGameHighScoresRequest -> String)
-> ([GetGameHighScoresRequest] -> ShowS)
-> Show GetGameHighScoresRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetGameHighScoresRequest -> ShowS
showsPrec :: Int -> GetGameHighScoresRequest -> ShowS
$cshow :: GetGameHighScoresRequest -> String
show :: GetGameHighScoresRequest -> String
$cshowList :: [GetGameHighScoresRequest] -> ShowS
showList :: [GetGameHighScoresRequest] -> ShowS
Show)

foldMap deriveJSON'
  [ ''SendGameRequest
  , ''SetGameScoreRequest
  , ''SetGameScoreResult
  ]

-- * Methods

-- ** 'sendGame'

type SendGame
  = "sendGame" :> ReqBody '[JSON] SendGameRequest :> Post '[JSON] (Response Message)

-- | Use this method to send a game. On success, the sent 'Message' is returned.
sendGame :: SendGameRequest -> ClientM (Response Message)
sendGame :: SendGameRequest -> ClientM (Response Message)
sendGame = Proxy SendGame -> Client ClientM SendGame
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendGame)

-- ** 'setGameScore'

type SetGameScore
  = "setGameScore" :> ReqBody '[JSON] SetGameScoreRequest :> Post '[JSON] (Response SetGameScoreResult)

-- | Use this method to set the score of the specified user in a game message. On success, if the message is not an inline message, the 'Message' is returned, otherwise True is returned. Returns an error, if the new score is not greater than the user's current score in the chat and force is False.
setGameScore :: SetGameScoreRequest -> ClientM (Response SetGameScoreResult)
setGameScore :: SetGameScoreRequest -> ClientM (Response SetGameScoreResult)
setGameScore = Proxy SetGameScore -> Client ClientM SetGameScore
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SetGameScore)

-- ** 'getGameHighScores'

type GetGameHighScores
  = "getGameHighScores" :> ReqBody '[JSON] GetGameHighScoresRequest :> Post '[JSON] (Response [GameHighScore])

foldMap makeDefault
  [ ''SendGameRequest
  , ''SetGameScoreRequest
  , ''GetGameHighScoresRequest
  ]