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

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

import Telegram.Bot.API.Types.Common 
import Telegram.Bot.API.Types.File
import Telegram.Bot.API.Types.InputMedia
import Telegram.Bot.API.Types.MaskPosition
import Telegram.Bot.API.Types.PhotoSize
import Telegram.Bot.API.Internal.Utils

-- ** 'InputSticker'

data InputSticker = InputSticker
  { InputSticker -> InputFile
inputStickerSticker :: InputFile -- ^ The added sticker. Pass a file_id as a String to send a file that already exists on the Telegram servers, pass an HTTP URL as a String for Telegram to get a file from the Internet, upload a new one using @multipart/form-data@, or pass @attach://<file_attach_name>@ to upload a new one using @multipart/form-data@ under @<file_attach_name>@ name. Animated and video stickers can't be uploaded via HTTP URL.
  , InputSticker -> [Text]
inputStickerEmojiList :: [Text] -- ^ List of 1-20 emoji associated with the sticker.
  , InputSticker -> Maybe MaskPosition
inputStickerMaskPosition :: Maybe MaskPosition -- ^ Position where the mask should be placed on faces. For “mask” stickers only.
  , InputSticker -> Maybe [Text]
inputStickerKeywords :: Maybe [Text] -- ^ List of 0-20 search keywords for the sticker with total length of up to 64 characters. For “regular” and “custom_emoji” stickers only.
  }
  deriving (forall x. Rep InputSticker x -> InputSticker
forall x. InputSticker -> Rep InputSticker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputSticker x -> InputSticker
$cfrom :: forall x. InputSticker -> Rep InputSticker x
Generic, Int -> InputSticker -> ShowS
[InputSticker] -> ShowS
InputSticker -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputSticker] -> ShowS
$cshowList :: [InputSticker] -> ShowS
show :: InputSticker -> String
$cshow :: InputSticker -> String
showsPrec :: Int -> InputSticker -> ShowS
$cshowsPrec :: Int -> InputSticker -> ShowS
Show)

instance ToJSON   InputSticker where toJSON :: InputSticker -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

-- ** 'Sticker'

-- | This object represents a sticker.
data Sticker = Sticker
  { Sticker -> FileId
stickerFileId       :: FileId             -- ^ Identifier for this file, which can be used to download or reuse the file.
  , Sticker -> FileId
stickerFileUniqueId :: FileId             -- ^ Unique identifier for this file, which is supposed to be the same over time and for different bots. Can't be used to download or reuse the file.
  , Sticker -> Int
stickerWidth        :: Int              -- ^ Sticker width.
  , Sticker -> Int
stickerHeight       :: Int              -- ^ Sticker height.
  , Sticker -> Bool
stickerIsAnimated   :: Bool               -- ^ 'True', if the sticker is animated.
  , Sticker -> Bool
stickerIsVideo      :: Bool               -- ^ 'True', if the sticker is a video sticker.
  , Sticker -> Maybe PhotoSize
stickerThumbnail    :: Maybe PhotoSize    -- ^ Sticker thumbnail in the .WEBP or .JPG format.
  , Sticker -> Maybe Text
stickerEmoji        :: Maybe Text         -- ^ Emoji associated with the sticker.
  , Sticker -> Maybe Text
stickerSetName      :: Maybe Text         -- ^ Name of the sticker set to which the sticker belongs.
  , Sticker -> Maybe File
stickerPremiumAnimation :: Maybe File    -- ^ For premium regular stickers, premium animation for the sticker.
  , Sticker -> Maybe MaskPosition
stickerMaskPosition :: Maybe MaskPosition -- ^ For mask stickers, the position where the mask should be placed.
  , Sticker -> Maybe Text
stickerCustomEmojiId :: Maybe Text        -- ^ For custom emoji stickers, unique identifier of the custom emoji.
  , Sticker -> Maybe Integer
stickerFileSize     :: Maybe Integer      -- ^ File size in bytes.
  , Sticker -> Maybe Bool
stickerNeedsRepainting  :: Maybe Bool      -- ^ Pass `True` if stickers in the sticker set must be repainted to the color of text when used in messages, the accent color if used as emoji status, white on chat photos, or another appropriate color based on context; for custom emoji sticker sets only.
  }
  deriving (forall x. Rep Sticker x -> Sticker
forall x. Sticker -> Rep Sticker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sticker x -> Sticker
$cfrom :: forall x. Sticker -> Rep Sticker x
Generic, Int -> Sticker -> ShowS
[Sticker] -> ShowS
Sticker -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sticker] -> ShowS
$cshowList :: [Sticker] -> ShowS
show :: Sticker -> String
$cshow :: Sticker -> String
showsPrec :: Int -> Sticker -> ShowS
$cshowsPrec :: Int -> Sticker -> ShowS
Show)

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

-- ** 'StickerSet'

-- | This object represents a sticker set.
data StickerSet = StickerSet
  { StickerSet -> Text
stickerSetName          :: Text            -- ^ Sticker set name.
  , StickerSet -> Text
stickerSetTitle         :: Text            -- ^ Sticker set title.
  , StickerSet -> StickerSetType
stickerSetType          :: StickerSetType  -- ^ Type of stickers in the set, currently one of “regular”, “mask”, “custom_emoji”.
  , StickerSet -> Bool
stickerSetIsAnimated    :: Bool            -- ^ 'True', if the sticker set contains animated stickers.
  , StickerSet -> Bool
stickerSetIsVideo       :: Bool            -- ^ 'True', if the sticker is a video sticker.
  , StickerSet -> Maybe Bool
stickerSetContainsMasks :: Maybe Bool      -- ^ True, if the sticker set contains masks.
  , StickerSet -> [Sticker]
stickerSetStickers      :: [Sticker]       -- ^ List of all set stickers.
  , StickerSet -> Maybe PhotoSize
stickerSetThumbnail     :: Maybe PhotoSize -- ^ Sticker set thumbnail in the .WEBP or .TGS format.
  }
  deriving (forall x. Rep StickerSet x -> StickerSet
forall x. StickerSet -> Rep StickerSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StickerSet x -> StickerSet
$cfrom :: forall x. StickerSet -> Rep StickerSet x
Generic, Int -> StickerSet -> ShowS
[StickerSet] -> ShowS
StickerSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickerSet] -> ShowS
$cshowList :: [StickerSet] -> ShowS
show :: StickerSet -> String
$cshow :: StickerSet -> String
showsPrec :: Int -> StickerSet -> ShowS
$cshowsPrec :: Int -> StickerSet -> ShowS
Show)

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


-- | Type of stickers in the set, currently one of “regular”, “mask”, “custom_emoji”.
data StickerSetType
  = StickerSetTypeRegular
  | StickerSetTypeMask
  | StickerSetTypeCustomEmoji
  deriving (StickerSetType -> StickerSetType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickerSetType -> StickerSetType -> Bool
$c/= :: StickerSetType -> StickerSetType -> Bool
== :: StickerSetType -> StickerSetType -> Bool
$c== :: StickerSetType -> StickerSetType -> Bool
Eq, Int -> StickerSetType -> ShowS
[StickerSetType] -> ShowS
StickerSetType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickerSetType] -> ShowS
$cshowList :: [StickerSetType] -> ShowS
show :: StickerSetType -> String
$cshow :: StickerSetType -> String
showsPrec :: Int -> StickerSetType -> ShowS
$cshowsPrec :: Int -> StickerSetType -> ShowS
Show, forall x. Rep StickerSetType x -> StickerSetType
forall x. StickerSetType -> Rep StickerSetType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StickerSetType x -> StickerSetType
$cfrom :: forall x. StickerSetType -> Rep StickerSetType x
Generic)

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