{-# 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, UserId)

-- * Types

-- ** 'SendGameRequest'

data SendGameRequest = SendGameRequest
  { SendGameRequest -> ChatId
sendGameRequestChatId                   :: ChatId                     -- ^ Unique identifier for the target chat.
  , SendGameRequest -> Text
sendGameRequestGameShortName            :: Text                       -- ^ Short name of the game, serves as the unique identifier for the game. Set up your games via Botfather.
  , SendGameRequest -> Maybe Bool
sendGameRequestDisableNotification      :: 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
sendGameRequestReplyToMessageId         :: Maybe MessageId            -- ^ If the message is a reply, ID of the original message.
  , SendGameRequest -> Maybe Bool
sendGameRequestAllowSendingWithoutReply :: Maybe Bool                 -- ^ Pass 'True', if the message should be sent even if the specified replied-to message is not found
  , SendGameRequest -> Maybe InlineKeyboardMarkup
sendGameRequestReplyMarkup              :: 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
$cto :: forall x. Rep SendGameRequest x -> SendGameRequest
$cfrom :: forall x. SendGameRequest -> Rep SendGameRequest x
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
showList :: [SendGameRequest] -> ShowS
$cshowList :: [SendGameRequest] -> ShowS
show :: SendGameRequest -> String
$cshow :: SendGameRequest -> String
showsPrec :: Int -> SendGameRequest -> ShowS
$cshowsPrec :: Int -> SendGameRequest -> ShowS
Show)

-- ** 'SetGameScoreRequest'

data SetGameScoreRequest = SetGameScoreRequest
  { SetGameScoreRequest -> UserId
setGameScoreRequestUserId             :: UserId          -- ^ User identifier.
  , SetGameScoreRequest -> Integer
setGameScoreRequestScore              :: Integer         -- ^ New score, must be non-negative.
  , SetGameScoreRequest -> Maybe Bool
setGameScoreRequestForce              :: 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
setGameScoreRequestDisableEditMessage :: Maybe Bool      -- ^ Pass 'True', if the game message should not be automatically edited to include the current scoreboard.
  , SetGameScoreRequest -> Maybe ChatId
setGameScoreRequestChatId             :: Maybe ChatId    -- ^ Required if @inline_message_id@ is not specified. Unique identifier for the target chat
  , SetGameScoreRequest -> Maybe MessageId
setGameScoreRequestMessageId          :: Maybe MessageId -- ^ Required if @inline_message_id@ is not specified. Identifier of the sent message.
  , SetGameScoreRequest -> Maybe MessageId
setGameScoreRequestInlineMessageId    :: 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
$cto :: forall x. Rep SetGameScoreRequest x -> SetGameScoreRequest
$cfrom :: forall x. SetGameScoreRequest -> Rep SetGameScoreRequest x
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
showList :: [SetGameScoreRequest] -> ShowS
$cshowList :: [SetGameScoreRequest] -> ShowS
show :: SetGameScoreRequest -> String
$cshow :: SetGameScoreRequest -> String
showsPrec :: Int -> SetGameScoreRequest -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SetGameScoreResult x -> SetGameScoreResult
$cfrom :: forall x. SetGameScoreResult -> Rep SetGameScoreResult x
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
showList :: [SetGameScoreResult] -> ShowS
$cshowList :: [SetGameScoreResult] -> ShowS
show :: SetGameScoreResult -> String
$cshow :: SetGameScoreResult -> String
showsPrec :: Int -> SetGameScoreResult -> ShowS
$cshowsPrec :: Int -> SetGameScoreResult -> ShowS
Show)

-- ** 'GetGameHighScoresRequest'

data GetGameHighScoresRequest = GetGameHighScoresRequest
  { GetGameHighScoresRequest -> UserId
getGameHighScoresRequestUserId          :: UserId          -- ^ Target user id.
  , GetGameHighScoresRequest -> Maybe ChatId
getGameHighScoresRequestChatId          :: Maybe ChatId    -- ^ Required if @inline_message_id@ is not specified. Unique identifier for the target chat.
  , GetGameHighScoresRequest -> Maybe MessageId
getGameHighScoresRequestMessageId       :: Maybe MessageId -- ^ Required if @inline_message_id@ is not specified. Identifier of the sent message.
  , GetGameHighScoresRequest -> Maybe MessageId
getGameHighScoresRequestInlineMessageId :: 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
$cto :: forall x.
Rep GetGameHighScoresRequest x -> GetGameHighScoresRequest
$cfrom :: forall x.
GetGameHighScoresRequest -> Rep GetGameHighScoresRequest x
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
showList :: [GetGameHighScoresRequest] -> ShowS
$cshowList :: [GetGameHighScoresRequest] -> ShowS
show :: GetGameHighScoresRequest -> String
$cshow :: GetGameHighScoresRequest -> String
showsPrec :: Int -> GetGameHighScoresRequest -> ShowS
$cshowsPrec :: Int -> 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 (Proxy SendGame
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 (Proxy SetGameScore
forall k (t :: k). Proxy t
Proxy @SetGameScore)

-- ** 'getGameHighScores'

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