{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Discord.Internal.Types.Emoji where

import Data.Aeson
import Data.Data
import Data.Functor ((<&>))
import Data.Text as T
import Discord.Internal.Types.Prelude
import Discord.Internal.Types.User

-- | Represents an emoticon (emoji)
data Emoji = Emoji
  { -- | The emoji id
    Emoji -> Maybe EmojiId
emojiId :: Maybe EmojiId,
    -- | The emoji name
    Emoji -> Text
emojiName :: T.Text,
    -- | Roles the emoji is active for
    Emoji -> Maybe [RoleId]
emojiRoles :: Maybe [RoleId],
    -- | User that created this emoji
    Emoji -> Maybe User
emojiUser :: Maybe User,
    -- | Whether this emoji is managed
    Emoji -> Maybe Bool
emojiManaged :: Maybe Bool,
    -- | Whether this emoji is animated
    Emoji -> Maybe Bool
emojiAnimated :: Maybe Bool
  }
  deriving (Int -> Emoji -> ShowS
[Emoji] -> ShowS
Emoji -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Emoji] -> ShowS
$cshowList :: [Emoji] -> ShowS
show :: Emoji -> String
$cshow :: Emoji -> String
showsPrec :: Int -> Emoji -> ShowS
$cshowsPrec :: Int -> Emoji -> ShowS
Show, ReadPrec [Emoji]
ReadPrec Emoji
Int -> ReadS Emoji
ReadS [Emoji]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Emoji]
$creadListPrec :: ReadPrec [Emoji]
readPrec :: ReadPrec Emoji
$creadPrec :: ReadPrec Emoji
readList :: ReadS [Emoji]
$creadList :: ReadS [Emoji]
readsPrec :: Int -> ReadS Emoji
$creadsPrec :: Int -> ReadS Emoji
Read, Emoji -> Emoji -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Emoji -> Emoji -> Bool
$c/= :: Emoji -> Emoji -> Bool
== :: Emoji -> Emoji -> Bool
$c== :: Emoji -> Emoji -> Bool
Eq, Eq Emoji
Emoji -> Emoji -> Bool
Emoji -> Emoji -> Ordering
Emoji -> Emoji -> Emoji
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Emoji -> Emoji -> Emoji
$cmin :: Emoji -> Emoji -> Emoji
max :: Emoji -> Emoji -> Emoji
$cmax :: Emoji -> Emoji -> Emoji
>= :: Emoji -> Emoji -> Bool
$c>= :: Emoji -> Emoji -> Bool
> :: Emoji -> Emoji -> Bool
$c> :: Emoji -> Emoji -> Bool
<= :: Emoji -> Emoji -> Bool
$c<= :: Emoji -> Emoji -> Bool
< :: Emoji -> Emoji -> Bool
$c< :: Emoji -> Emoji -> Bool
compare :: Emoji -> Emoji -> Ordering
$ccompare :: Emoji -> Emoji -> Ordering
Ord)

-- | Make an emoji with only a name
mkEmoji :: T.Text -> Emoji
mkEmoji :: Text -> Emoji
mkEmoji Text
t = Maybe EmojiId
-> Text
-> Maybe [RoleId]
-> Maybe User
-> Maybe Bool
-> Maybe Bool
-> Emoji
Emoji forall a. Maybe a
Nothing Text
t forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

instance FromJSON Emoji where
  parseJSON :: Value -> Parser Emoji
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Emoji" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe EmojiId
-> Text
-> Maybe [RoleId]
-> Maybe User
-> Maybe Bool
-> Maybe Bool
-> Emoji
Emoji forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"managed"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"animated"

instance ToJSON Emoji where
  toJSON :: Emoji -> Value
toJSON Emoji {Maybe Bool
Maybe [RoleId]
Maybe EmojiId
Maybe User
Text
emojiAnimated :: Maybe Bool
emojiManaged :: Maybe Bool
emojiUser :: Maybe User
emojiRoles :: Maybe [RoleId]
emojiName :: Text
emojiId :: Maybe EmojiId
emojiAnimated :: Emoji -> Maybe Bool
emojiManaged :: Emoji -> Maybe Bool
emojiUser :: Emoji -> Maybe User
emojiRoles :: Emoji -> Maybe [RoleId]
emojiName :: Emoji -> Text
emojiId :: Emoji -> Maybe EmojiId
..} =
    [Maybe Pair] -> Value
objectFromMaybes
            [ Key
"id" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe EmojiId
emojiId,
              Key
"name" forall a. ToJSON a => Key -> a -> Maybe Pair
.== Text
emojiName,
              Key
"roles" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe [RoleId]
emojiRoles,
              Key
"user" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe User
emojiUser,
              Key
"managed" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
emojiManaged,
              Key
"animated" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
emojiAnimated
            ]

-- | Represents a pack of standard stickers.
data StickerPack = StickerPack
  { -- | The id of the sticker pack
    StickerPack -> Snowflake
stickerPackId :: Snowflake,
    -- | The stickers in the pack
    StickerPack -> [Sticker]
stickerPackStickers :: [Sticker],
    -- | The name of the sticker pack
    StickerPack -> Text
stickerPackName :: T.Text,
    -- | ID of the pack's SKU
    StickerPack -> Snowflake
stickerPackSKUId :: Snowflake,
    -- | If of the sticker which is shown as the pack's icon
    StickerPack -> Maybe StickerId
stickerPackCoverStickerId :: Maybe StickerId,
    -- | The description of the sticker pack
    StickerPack -> Text
stickerPackDescription :: T.Text,
    -- | Id of the sticker pack's banner image
    StickerPack -> Maybe Snowflake
stickerPackBannerAssetId :: Maybe Snowflake
  }
  deriving (Int -> StickerPack -> ShowS
[StickerPack] -> ShowS
StickerPack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickerPack] -> ShowS
$cshowList :: [StickerPack] -> ShowS
show :: StickerPack -> String
$cshow :: StickerPack -> String
showsPrec :: Int -> StickerPack -> ShowS
$cshowsPrec :: Int -> StickerPack -> ShowS
Show, ReadPrec [StickerPack]
ReadPrec StickerPack
Int -> ReadS StickerPack
ReadS [StickerPack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickerPack]
$creadListPrec :: ReadPrec [StickerPack]
readPrec :: ReadPrec StickerPack
$creadPrec :: ReadPrec StickerPack
readList :: ReadS [StickerPack]
$creadList :: ReadS [StickerPack]
readsPrec :: Int -> ReadS StickerPack
$creadsPrec :: Int -> ReadS StickerPack
Read, StickerPack -> StickerPack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickerPack -> StickerPack -> Bool
$c/= :: StickerPack -> StickerPack -> Bool
== :: StickerPack -> StickerPack -> Bool
$c== :: StickerPack -> StickerPack -> Bool
Eq, Eq StickerPack
StickerPack -> StickerPack -> Bool
StickerPack -> StickerPack -> Ordering
StickerPack -> StickerPack -> StickerPack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StickerPack -> StickerPack -> StickerPack
$cmin :: StickerPack -> StickerPack -> StickerPack
max :: StickerPack -> StickerPack -> StickerPack
$cmax :: StickerPack -> StickerPack -> StickerPack
>= :: StickerPack -> StickerPack -> Bool
$c>= :: StickerPack -> StickerPack -> Bool
> :: StickerPack -> StickerPack -> Bool
$c> :: StickerPack -> StickerPack -> Bool
<= :: StickerPack -> StickerPack -> Bool
$c<= :: StickerPack -> StickerPack -> Bool
< :: StickerPack -> StickerPack -> Bool
$c< :: StickerPack -> StickerPack -> Bool
compare :: StickerPack -> StickerPack -> Ordering
$ccompare :: StickerPack -> StickerPack -> Ordering
Ord)

instance FromJSON StickerPack where
  parseJSON :: Value -> Parser StickerPack
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StickerPack" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Snowflake
-> [Sticker]
-> Text
-> Snowflake
-> Maybe StickerId
-> Text
-> Maybe Snowflake
-> StickerPack
StickerPack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stickers"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sku_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cover_sticker_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"banner_asset_id"

-- | A full sticker object
data Sticker = Sticker
  { -- | The sticker's id.
    Sticker -> StickerId
stickerId :: StickerId,
    -- | For standard stickers, the id of the pack.
    Sticker -> Maybe Snowflake
stickerStickerPackId :: Maybe Snowflake,
    -- | The sticker's name.
    Sticker -> Text
stickerName :: T.Text,
    -- | The sticker's description.
    Sticker -> Maybe Text
stickerDescription :: Maybe T.Text,
    -- | Autocomplete/suggestion tags for the sticker (max 200 characters total).
    Sticker -> [Text]
stickerTags :: [T.Text],
    -- | Whether the sticker is standard or guild type.
    Sticker -> Bool
stickerIsStandardType :: Bool,
    -- | The sticker's format type.
    Sticker -> StickerFormatType
stickerFormatType :: StickerFormatType,
    -- | Whether this guild sticker can be used.
    Sticker -> Maybe Bool
stickerAvailable :: Maybe Bool,
    -- | What guild owns this sticker.
    Sticker -> Maybe GuildId
stickerGuildId :: Maybe GuildId,
    -- | What user uploaded the guild sticker.
    Sticker -> Maybe User
stickerUser :: Maybe User,
    -- | A standard sticker's sort order in its pack.
    Sticker -> Maybe Integer
stickerSortValue :: Maybe Integer
  }
  deriving (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, ReadPrec [Sticker]
ReadPrec Sticker
Int -> ReadS Sticker
ReadS [Sticker]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sticker]
$creadListPrec :: ReadPrec [Sticker]
readPrec :: ReadPrec Sticker
$creadPrec :: ReadPrec Sticker
readList :: ReadS [Sticker]
$creadList :: ReadS [Sticker]
readsPrec :: Int -> ReadS Sticker
$creadsPrec :: Int -> ReadS Sticker
Read, Sticker -> Sticker -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sticker -> Sticker -> Bool
$c/= :: Sticker -> Sticker -> Bool
== :: Sticker -> Sticker -> Bool
$c== :: Sticker -> Sticker -> Bool
Eq, Eq Sticker
Sticker -> Sticker -> Bool
Sticker -> Sticker -> Ordering
Sticker -> Sticker -> Sticker
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Sticker -> Sticker -> Sticker
$cmin :: Sticker -> Sticker -> Sticker
max :: Sticker -> Sticker -> Sticker
$cmax :: Sticker -> Sticker -> Sticker
>= :: Sticker -> Sticker -> Bool
$c>= :: Sticker -> Sticker -> Bool
> :: Sticker -> Sticker -> Bool
$c> :: Sticker -> Sticker -> Bool
<= :: Sticker -> Sticker -> Bool
$c<= :: Sticker -> Sticker -> Bool
< :: Sticker -> Sticker -> Bool
$c< :: Sticker -> Sticker -> Bool
compare :: Sticker -> Sticker -> Ordering
$ccompare :: Sticker -> Sticker -> Ordering
Ord)

instance FromJSON Sticker where
  parseJSON :: Value -> Parser Sticker
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Sticker" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    StickerId
-> Maybe Snowflake
-> Text
-> Maybe Text
-> [Text]
-> Bool
-> StickerFormatType
-> Maybe Bool
-> Maybe GuildId
-> Maybe User
-> Maybe Integer
-> Sticker
Sticker forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pack_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tags") forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text -> [Text]
T.splitOn Text
"\n")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type") forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. Eq a => a -> a -> Bool
== (Int
1 :: Int)))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"format_type"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"available"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sort_value"

-- | A simplified sticker object.
data StickerItem = StickerItem
  { -- | The sticker's id.
    StickerItem -> StickerId
stickerItemId :: StickerId,
    -- | The sticker's name.
    StickerItem -> Text
stickerItemName :: T.Text,
    -- | The sticker's format type.
    StickerItem -> StickerFormatType
stickerItemFormatType :: StickerFormatType
  }
  deriving (Int -> StickerItem -> ShowS
[StickerItem] -> ShowS
StickerItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickerItem] -> ShowS
$cshowList :: [StickerItem] -> ShowS
show :: StickerItem -> String
$cshow :: StickerItem -> String
showsPrec :: Int -> StickerItem -> ShowS
$cshowsPrec :: Int -> StickerItem -> ShowS
Show, ReadPrec [StickerItem]
ReadPrec StickerItem
Int -> ReadS StickerItem
ReadS [StickerItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickerItem]
$creadListPrec :: ReadPrec [StickerItem]
readPrec :: ReadPrec StickerItem
$creadPrec :: ReadPrec StickerItem
readList :: ReadS [StickerItem]
$creadList :: ReadS [StickerItem]
readsPrec :: Int -> ReadS StickerItem
$creadsPrec :: Int -> ReadS StickerItem
Read, StickerItem -> StickerItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickerItem -> StickerItem -> Bool
$c/= :: StickerItem -> StickerItem -> Bool
== :: StickerItem -> StickerItem -> Bool
$c== :: StickerItem -> StickerItem -> Bool
Eq, Eq StickerItem
StickerItem -> StickerItem -> Bool
StickerItem -> StickerItem -> Ordering
StickerItem -> StickerItem -> StickerItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StickerItem -> StickerItem -> StickerItem
$cmin :: StickerItem -> StickerItem -> StickerItem
max :: StickerItem -> StickerItem -> StickerItem
$cmax :: StickerItem -> StickerItem -> StickerItem
>= :: StickerItem -> StickerItem -> Bool
$c>= :: StickerItem -> StickerItem -> Bool
> :: StickerItem -> StickerItem -> Bool
$c> :: StickerItem -> StickerItem -> Bool
<= :: StickerItem -> StickerItem -> Bool
$c<= :: StickerItem -> StickerItem -> Bool
< :: StickerItem -> StickerItem -> Bool
$c< :: StickerItem -> StickerItem -> Bool
compare :: StickerItem -> StickerItem -> Ordering
$ccompare :: StickerItem -> StickerItem -> Ordering
Ord)

instance FromJSON StickerItem where
  parseJSON :: Value -> Parser StickerItem
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StickerItem" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    StickerId -> Text -> StickerFormatType -> StickerItem
StickerItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"format_type"

instance ToJSON StickerItem where
  toJSON :: StickerItem -> Value
toJSON StickerItem {Text
StickerId
StickerFormatType
stickerItemFormatType :: StickerFormatType
stickerItemName :: Text
stickerItemId :: StickerId
stickerItemFormatType :: StickerItem -> StickerFormatType
stickerItemName :: StickerItem -> Text
stickerItemId :: StickerItem -> StickerId
..} =
    [Pair] -> Value
object
      [ (Key
"id", forall a. ToJSON a => a -> Value
toJSON StickerId
stickerItemId),
        (Key
"name", forall a. ToJSON a => a -> Value
toJSON Text
stickerItemName),
        (Key
"format_type", forall a. ToJSON a => a -> Value
toJSON StickerFormatType
stickerItemFormatType)
      ]

-- | The format of a sticker
data StickerFormatType
  = StickerFormatTypePNG
  | StickerFormatTypeAPNG
  | StickerFormatTypeLOTTIE
  deriving (Int -> StickerFormatType -> ShowS
[StickerFormatType] -> ShowS
StickerFormatType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickerFormatType] -> ShowS
$cshowList :: [StickerFormatType] -> ShowS
show :: StickerFormatType -> String
$cshow :: StickerFormatType -> String
showsPrec :: Int -> StickerFormatType -> ShowS
$cshowsPrec :: Int -> StickerFormatType -> ShowS
Show, ReadPrec [StickerFormatType]
ReadPrec StickerFormatType
Int -> ReadS StickerFormatType
ReadS [StickerFormatType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickerFormatType]
$creadListPrec :: ReadPrec [StickerFormatType]
readPrec :: ReadPrec StickerFormatType
$creadPrec :: ReadPrec StickerFormatType
readList :: ReadS [StickerFormatType]
$creadList :: ReadS [StickerFormatType]
readsPrec :: Int -> ReadS StickerFormatType
$creadsPrec :: Int -> ReadS StickerFormatType
Read, StickerFormatType -> StickerFormatType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickerFormatType -> StickerFormatType -> Bool
$c/= :: StickerFormatType -> StickerFormatType -> Bool
== :: StickerFormatType -> StickerFormatType -> Bool
$c== :: StickerFormatType -> StickerFormatType -> Bool
Eq, Eq StickerFormatType
StickerFormatType -> StickerFormatType -> Bool
StickerFormatType -> StickerFormatType -> Ordering
StickerFormatType -> StickerFormatType -> StickerFormatType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StickerFormatType -> StickerFormatType -> StickerFormatType
$cmin :: StickerFormatType -> StickerFormatType -> StickerFormatType
max :: StickerFormatType -> StickerFormatType -> StickerFormatType
$cmax :: StickerFormatType -> StickerFormatType -> StickerFormatType
>= :: StickerFormatType -> StickerFormatType -> Bool
$c>= :: StickerFormatType -> StickerFormatType -> Bool
> :: StickerFormatType -> StickerFormatType -> Bool
$c> :: StickerFormatType -> StickerFormatType -> Bool
<= :: StickerFormatType -> StickerFormatType -> Bool
$c<= :: StickerFormatType -> StickerFormatType -> Bool
< :: StickerFormatType -> StickerFormatType -> Bool
$c< :: StickerFormatType -> StickerFormatType -> Bool
compare :: StickerFormatType -> StickerFormatType -> Ordering
$ccompare :: StickerFormatType -> StickerFormatType -> Ordering
Ord, Typeable StickerFormatType
StickerFormatType -> DataType
StickerFormatType -> Constr
(forall b. Data b => b -> b)
-> StickerFormatType -> StickerFormatType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> StickerFormatType -> u
forall u. (forall d. Data d => d -> u) -> StickerFormatType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StickerFormatType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StickerFormatType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickerFormatType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StickerFormatType -> c StickerFormatType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StickerFormatType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickerFormatType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StickerFormatType -> m StickerFormatType
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StickerFormatType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StickerFormatType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> StickerFormatType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StickerFormatType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StickerFormatType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StickerFormatType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StickerFormatType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StickerFormatType -> r
gmapT :: (forall b. Data b => b -> b)
-> StickerFormatType -> StickerFormatType
$cgmapT :: (forall b. Data b => b -> b)
-> StickerFormatType -> StickerFormatType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickerFormatType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StickerFormatType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StickerFormatType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StickerFormatType)
dataTypeOf :: StickerFormatType -> DataType
$cdataTypeOf :: StickerFormatType -> DataType
toConstr :: StickerFormatType -> Constr
$ctoConstr :: StickerFormatType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickerFormatType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StickerFormatType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StickerFormatType -> c StickerFormatType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StickerFormatType -> c StickerFormatType
Data)

instance InternalDiscordEnum StickerFormatType where
  discordTypeStartValue :: StickerFormatType
discordTypeStartValue = StickerFormatType
StickerFormatTypePNG
  fromDiscordType :: StickerFormatType -> Int
fromDiscordType StickerFormatType
StickerFormatTypePNG = Int
1
  fromDiscordType StickerFormatType
StickerFormatTypeAPNG = Int
2
  fromDiscordType StickerFormatType
StickerFormatTypeLOTTIE = Int
3

instance ToJSON StickerFormatType where
  toJSON :: StickerFormatType -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. InternalDiscordEnum a => a -> Int
fromDiscordType

instance FromJSON StickerFormatType where
  parseJSON :: Value -> Parser StickerFormatType
parseJSON = forall a. InternalDiscordEnum a => String -> Value -> Parser a
discordTypeParseJSON String
"StickerFormatType"