{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RankNTypes  #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}

-- | Provides base types and utility functions needed for modules in Discord.Internal.Types
module Discord.Internal.Types.Prelude
  ( Auth (..)
  , authToken

  , Snowflake (..)
  , snowflakeCreationDate

  , RolePermissions (..)
  
  , DiscordId (..)
  , ChannelId
  , StageId
  , GuildId
  , MessageId
  , AttachmentId
  , EmojiId
  , StickerId
  , UserId
  , DiscordTeamId
  , GameSKUId
  , RoleId
  , IntegrationId
  , WebhookId
  , ParentId
  , ApplicationId
  , ApplicationCommandId
  , InteractionId
  , ScheduledEventId
  , ScheduledEventEntityId
  , AuditLogEntryId
  , AutoModerationRuleId

  , DiscordToken (..)
  , InteractionToken
  , WebhookToken

  , Shard
  , epochTime

  , InternalDiscordEnum (..)

  , Base64Image (..)
  , getMimeType

  , (.==)
  , (.=?)
  , objectFromMaybes

  , ChannelTypeOption (..)
  )

 where

import Data.Bits (Bits(shiftR))
import Data.Data (Data (dataTypeOf), dataTypeConstrs, fromConstr)
import Data.Word (Word64)
import Data.Maybe (catMaybes)
import Text.Read (readMaybe)
import Data.Hashable (Hashable)

import Data.Aeson.Types
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Web.HttpApiData

import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Aeson.Key as Key
import qualified Data.Text.Encoding as T.E

-- | Authorization token for the Discord API
newtype Auth = Auth T.Text
  deriving (Int -> Auth -> ShowS
[Auth] -> ShowS
Auth -> String
(Int -> Auth -> ShowS)
-> (Auth -> String) -> ([Auth] -> ShowS) -> Show Auth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Auth -> ShowS
showsPrec :: Int -> Auth -> ShowS
$cshow :: Auth -> String
show :: Auth -> String
$cshowList :: [Auth] -> ShowS
showList :: [Auth] -> ShowS
Show, ReadPrec [Auth]
ReadPrec Auth
Int -> ReadS Auth
ReadS [Auth]
(Int -> ReadS Auth)
-> ReadS [Auth] -> ReadPrec Auth -> ReadPrec [Auth] -> Read Auth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Auth
readsPrec :: Int -> ReadS Auth
$creadList :: ReadS [Auth]
readList :: ReadS [Auth]
$creadPrec :: ReadPrec Auth
readPrec :: ReadPrec Auth
$creadListPrec :: ReadPrec [Auth]
readListPrec :: ReadPrec [Auth]
Read, Auth -> Auth -> Bool
(Auth -> Auth -> Bool) -> (Auth -> Auth -> Bool) -> Eq Auth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Auth -> Auth -> Bool
== :: Auth -> Auth -> Bool
$c/= :: Auth -> Auth -> Bool
/= :: Auth -> Auth -> Bool
Eq, Eq Auth
Eq Auth =>
(Auth -> Auth -> Ordering)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Auth)
-> (Auth -> Auth -> Auth)
-> Ord Auth
Auth -> Auth -> Bool
Auth -> Auth -> Ordering
Auth -> Auth -> Auth
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
$ccompare :: Auth -> Auth -> Ordering
compare :: Auth -> Auth -> Ordering
$c< :: Auth -> Auth -> Bool
< :: Auth -> Auth -> Bool
$c<= :: Auth -> Auth -> Bool
<= :: Auth -> Auth -> Bool
$c> :: Auth -> Auth -> Bool
> :: Auth -> Auth -> Bool
$c>= :: Auth -> Auth -> Bool
>= :: Auth -> Auth -> Bool
$cmax :: Auth -> Auth -> Auth
max :: Auth -> Auth -> Auth
$cmin :: Auth -> Auth -> Auth
min :: Auth -> Auth -> Auth
Ord)


-- | Get the raw token formatted for use with the websocket gateway
authToken :: Auth -> T.Text
authToken :: Auth -> Text
authToken (Auth Text
tok) = let token :: Text
token = Text -> Text
T.strip Text
tok
                           bot :: Text
bot = if Text
"Bot " Text -> Text -> Bool
`T.isPrefixOf` Text
token then Text
"" else Text
"Bot "
                       in Text
bot Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
token

-- | A unique integer identifier. Can be used to calculate the creation date of an entity.
newtype Snowflake = Snowflake { Snowflake -> Word64
unSnowflake :: Word64 }
  deriving newtype (Eq Snowflake
Eq Snowflake =>
(Snowflake -> Snowflake -> Ordering)
-> (Snowflake -> Snowflake -> Bool)
-> (Snowflake -> Snowflake -> Bool)
-> (Snowflake -> Snowflake -> Bool)
-> (Snowflake -> Snowflake -> Bool)
-> (Snowflake -> Snowflake -> Snowflake)
-> (Snowflake -> Snowflake -> Snowflake)
-> Ord Snowflake
Snowflake -> Snowflake -> Bool
Snowflake -> Snowflake -> Ordering
Snowflake -> Snowflake -> Snowflake
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
$ccompare :: Snowflake -> Snowflake -> Ordering
compare :: Snowflake -> Snowflake -> Ordering
$c< :: Snowflake -> Snowflake -> Bool
< :: Snowflake -> Snowflake -> Bool
$c<= :: Snowflake -> Snowflake -> Bool
<= :: Snowflake -> Snowflake -> Bool
$c> :: Snowflake -> Snowflake -> Bool
> :: Snowflake -> Snowflake -> Bool
$c>= :: Snowflake -> Snowflake -> Bool
>= :: Snowflake -> Snowflake -> Bool
$cmax :: Snowflake -> Snowflake -> Snowflake
max :: Snowflake -> Snowflake -> Snowflake
$cmin :: Snowflake -> Snowflake -> Snowflake
min :: Snowflake -> Snowflake -> Snowflake
Ord, Snowflake -> Snowflake -> Bool
(Snowflake -> Snowflake -> Bool)
-> (Snowflake -> Snowflake -> Bool) -> Eq Snowflake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Snowflake -> Snowflake -> Bool
== :: Snowflake -> Snowflake -> Bool
$c/= :: Snowflake -> Snowflake -> Bool
/= :: Snowflake -> Snowflake -> Bool
Eq, Eq Snowflake
Eq Snowflake =>
(Int -> Snowflake -> Int)
-> (Snowflake -> Int) -> Hashable Snowflake
Int -> Snowflake -> Int
Snowflake -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Snowflake -> Int
hashWithSalt :: Int -> Snowflake -> Int
$chash :: Snowflake -> Int
hash :: Snowflake -> Int
Hashable, Int -> Snowflake -> ShowS
[Snowflake] -> ShowS
Snowflake -> String
(Int -> Snowflake -> ShowS)
-> (Snowflake -> String)
-> ([Snowflake] -> ShowS)
-> Show Snowflake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Snowflake -> ShowS
showsPrec :: Int -> Snowflake -> ShowS
$cshow :: Snowflake -> String
show :: Snowflake -> String
$cshowList :: [Snowflake] -> ShowS
showList :: [Snowflake] -> ShowS
Show, ReadPrec [Snowflake]
ReadPrec Snowflake
Int -> ReadS Snowflake
ReadS [Snowflake]
(Int -> ReadS Snowflake)
-> ReadS [Snowflake]
-> ReadPrec Snowflake
-> ReadPrec [Snowflake]
-> Read Snowflake
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Snowflake
readsPrec :: Int -> ReadS Snowflake
$creadList :: ReadS [Snowflake]
readList :: ReadS [Snowflake]
$creadPrec :: ReadPrec Snowflake
readPrec :: ReadPrec Snowflake
$creadListPrec :: ReadPrec [Snowflake]
readListPrec :: ReadPrec [Snowflake]
Read, ToJSONKeyFunction [Snowflake]
ToJSONKeyFunction Snowflake
ToJSONKeyFunction Snowflake
-> ToJSONKeyFunction [Snowflake] -> ToJSONKey Snowflake
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction Snowflake
toJSONKey :: ToJSONKeyFunction Snowflake
$ctoJSONKeyList :: ToJSONKeyFunction [Snowflake]
toJSONKeyList :: ToJSONKeyFunction [Snowflake]
ToJSONKey, FromJSONKeyFunction [Snowflake]
FromJSONKeyFunction Snowflake
FromJSONKeyFunction Snowflake
-> FromJSONKeyFunction [Snowflake] -> FromJSONKey Snowflake
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction Snowflake
fromJSONKey :: FromJSONKeyFunction Snowflake
$cfromJSONKeyList :: FromJSONKeyFunction [Snowflake]
fromJSONKeyList :: FromJSONKeyFunction [Snowflake]
FromJSONKey, Snowflake -> Text
Snowflake -> ByteString
Snowflake -> Builder
(Snowflake -> Text)
-> (Snowflake -> Builder)
-> (Snowflake -> ByteString)
-> (Snowflake -> Text)
-> (Snowflake -> Builder)
-> ToHttpApiData Snowflake
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Snowflake -> Text
toUrlPiece :: Snowflake -> Text
$ctoEncodedUrlPiece :: Snowflake -> Builder
toEncodedUrlPiece :: Snowflake -> Builder
$ctoHeader :: Snowflake -> ByteString
toHeader :: Snowflake -> ByteString
$ctoQueryParam :: Snowflake -> Text
toQueryParam :: Snowflake -> Text
$ctoEncodedQueryParam :: Snowflake -> Builder
toEncodedQueryParam :: Snowflake -> Builder
ToHttpApiData)

instance ToJSON Snowflake where
  toJSON :: Snowflake -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Snowflake -> Text) -> Snowflake -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Snowflake -> String) -> Snowflake -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snowflake -> String
forall a. Show a => a -> String
show

instance FromJSON Snowflake where
  parseJSON :: Value -> Parser Snowflake
parseJSON =
    String -> (Text -> Parser Snowflake) -> Value -> Parser Snowflake
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText
      String
"Snowflake"
      ( \Text
snowflake ->
          case String -> Maybe Snowflake
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
snowflake) of
            Maybe Snowflake
Nothing -> String -> Parser Snowflake
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Snowflake) -> String -> Parser Snowflake
forall a b. (a -> b) -> a -> b
$ String
"invalid snowflake: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
snowflake
            (Just Snowflake
i) -> Snowflake -> Parser Snowflake
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Snowflake
i
      )

newtype RolePermissions = RolePermissions { RolePermissions -> Integer
getRolePermissions :: Integer } 
  deriving newtype (RolePermissions -> RolePermissions -> Bool
(RolePermissions -> RolePermissions -> Bool)
-> (RolePermissions -> RolePermissions -> Bool)
-> Eq RolePermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RolePermissions -> RolePermissions -> Bool
== :: RolePermissions -> RolePermissions -> Bool
$c/= :: RolePermissions -> RolePermissions -> Bool
/= :: RolePermissions -> RolePermissions -> Bool
Eq, Eq RolePermissions
Eq RolePermissions =>
(RolePermissions -> RolePermissions -> Ordering)
-> (RolePermissions -> RolePermissions -> Bool)
-> (RolePermissions -> RolePermissions -> Bool)
-> (RolePermissions -> RolePermissions -> Bool)
-> (RolePermissions -> RolePermissions -> Bool)
-> (RolePermissions -> RolePermissions -> RolePermissions)
-> (RolePermissions -> RolePermissions -> RolePermissions)
-> Ord RolePermissions
RolePermissions -> RolePermissions -> Bool
RolePermissions -> RolePermissions -> Ordering
RolePermissions -> RolePermissions -> RolePermissions
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
$ccompare :: RolePermissions -> RolePermissions -> Ordering
compare :: RolePermissions -> RolePermissions -> Ordering
$c< :: RolePermissions -> RolePermissions -> Bool
< :: RolePermissions -> RolePermissions -> Bool
$c<= :: RolePermissions -> RolePermissions -> Bool
<= :: RolePermissions -> RolePermissions -> Bool
$c> :: RolePermissions -> RolePermissions -> Bool
> :: RolePermissions -> RolePermissions -> Bool
$c>= :: RolePermissions -> RolePermissions -> Bool
>= :: RolePermissions -> RolePermissions -> Bool
$cmax :: RolePermissions -> RolePermissions -> RolePermissions
max :: RolePermissions -> RolePermissions -> RolePermissions
$cmin :: RolePermissions -> RolePermissions -> RolePermissions
min :: RolePermissions -> RolePermissions -> RolePermissions
Ord, Eq RolePermissions
RolePermissions
Eq RolePermissions =>
(RolePermissions -> RolePermissions -> RolePermissions)
-> (RolePermissions -> RolePermissions -> RolePermissions)
-> (RolePermissions -> RolePermissions -> RolePermissions)
-> (RolePermissions -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> RolePermissions
-> (Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> Bool)
-> (RolePermissions -> Maybe Int)
-> (RolePermissions -> Int)
-> (RolePermissions -> Bool)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int -> RolePermissions)
-> (RolePermissions -> Int)
-> Bits RolePermissions
Int -> RolePermissions
RolePermissions -> Bool
RolePermissions -> Int
RolePermissions -> Maybe Int
RolePermissions -> RolePermissions
RolePermissions -> Int -> Bool
RolePermissions -> Int -> RolePermissions
RolePermissions -> RolePermissions -> RolePermissions
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: RolePermissions -> RolePermissions -> RolePermissions
.&. :: RolePermissions -> RolePermissions -> RolePermissions
$c.|. :: RolePermissions -> RolePermissions -> RolePermissions
.|. :: RolePermissions -> RolePermissions -> RolePermissions
$cxor :: RolePermissions -> RolePermissions -> RolePermissions
xor :: RolePermissions -> RolePermissions -> RolePermissions
$ccomplement :: RolePermissions -> RolePermissions
complement :: RolePermissions -> RolePermissions
$cshift :: RolePermissions -> Int -> RolePermissions
shift :: RolePermissions -> Int -> RolePermissions
$crotate :: RolePermissions -> Int -> RolePermissions
rotate :: RolePermissions -> Int -> RolePermissions
$czeroBits :: RolePermissions
zeroBits :: RolePermissions
$cbit :: Int -> RolePermissions
bit :: Int -> RolePermissions
$csetBit :: RolePermissions -> Int -> RolePermissions
setBit :: RolePermissions -> Int -> RolePermissions
$cclearBit :: RolePermissions -> Int -> RolePermissions
clearBit :: RolePermissions -> Int -> RolePermissions
$ccomplementBit :: RolePermissions -> Int -> RolePermissions
complementBit :: RolePermissions -> Int -> RolePermissions
$ctestBit :: RolePermissions -> Int -> Bool
testBit :: RolePermissions -> Int -> Bool
$cbitSizeMaybe :: RolePermissions -> Maybe Int
bitSizeMaybe :: RolePermissions -> Maybe Int
$cbitSize :: RolePermissions -> Int
bitSize :: RolePermissions -> Int
$cisSigned :: RolePermissions -> Bool
isSigned :: RolePermissions -> Bool
$cshiftL :: RolePermissions -> Int -> RolePermissions
shiftL :: RolePermissions -> Int -> RolePermissions
$cunsafeShiftL :: RolePermissions -> Int -> RolePermissions
unsafeShiftL :: RolePermissions -> Int -> RolePermissions
$cshiftR :: RolePermissions -> Int -> RolePermissions
shiftR :: RolePermissions -> Int -> RolePermissions
$cunsafeShiftR :: RolePermissions -> Int -> RolePermissions
unsafeShiftR :: RolePermissions -> Int -> RolePermissions
$crotateL :: RolePermissions -> Int -> RolePermissions
rotateL :: RolePermissions -> Int -> RolePermissions
$crotateR :: RolePermissions -> Int -> RolePermissions
rotateR :: RolePermissions -> Int -> RolePermissions
$cpopCount :: RolePermissions -> Int
popCount :: RolePermissions -> Int
Bits, ReadPrec [RolePermissions]
ReadPrec RolePermissions
Int -> ReadS RolePermissions
ReadS [RolePermissions]
(Int -> ReadS RolePermissions)
-> ReadS [RolePermissions]
-> ReadPrec RolePermissions
-> ReadPrec [RolePermissions]
-> Read RolePermissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RolePermissions
readsPrec :: Int -> ReadS RolePermissions
$creadList :: ReadS [RolePermissions]
readList :: ReadS [RolePermissions]
$creadPrec :: ReadPrec RolePermissions
readPrec :: ReadPrec RolePermissions
$creadListPrec :: ReadPrec [RolePermissions]
readListPrec :: ReadPrec [RolePermissions]
Read, Int -> RolePermissions -> ShowS
[RolePermissions] -> ShowS
RolePermissions -> String
(Int -> RolePermissions -> ShowS)
-> (RolePermissions -> String)
-> ([RolePermissions] -> ShowS)
-> Show RolePermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RolePermissions -> ShowS
showsPrec :: Int -> RolePermissions -> ShowS
$cshow :: RolePermissions -> String
show :: RolePermissions -> String
$cshowList :: [RolePermissions] -> ShowS
showList :: [RolePermissions] -> ShowS
Show, [RolePermissions] -> Value
[RolePermissions] -> Encoding
RolePermissions -> Bool
RolePermissions -> Value
RolePermissions -> Encoding
(RolePermissions -> Value)
-> (RolePermissions -> Encoding)
-> ([RolePermissions] -> Value)
-> ([RolePermissions] -> Encoding)
-> (RolePermissions -> Bool)
-> ToJSON RolePermissions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RolePermissions -> Value
toJSON :: RolePermissions -> Value
$ctoEncoding :: RolePermissions -> Encoding
toEncoding :: RolePermissions -> Encoding
$ctoJSONList :: [RolePermissions] -> Value
toJSONList :: [RolePermissions] -> Value
$ctoEncodingList :: [RolePermissions] -> Encoding
toEncodingList :: [RolePermissions] -> Encoding
$comitField :: RolePermissions -> Bool
omitField :: RolePermissions -> Bool
ToJSON)

-- In v8 and above, all permissions are serialized as strings.
-- See https://discord.com/developers/docs/topics/permissions#permissions.
instance FromJSON RolePermissions where
  parseJSON :: Value -> Parser RolePermissions
parseJSON = String
-> (Text -> Parser RolePermissions)
-> Value
-> Parser RolePermissions
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RolePermissions" ((Text -> Parser RolePermissions)
 -> Value -> Parser RolePermissions)
-> (Text -> Parser RolePermissions)
-> Value
-> Parser RolePermissions
forall a b. (a -> b) -> a -> b
$
      \Text
text -> case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
text) of
              Just Integer
perms -> RolePermissions -> Parser RolePermissions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RolePermissions -> Parser RolePermissions)
-> RolePermissions -> Parser RolePermissions
forall a b. (a -> b) -> a -> b
$ Integer -> RolePermissions
RolePermissions Integer
perms
              Maybe Integer
Nothing    -> String -> Parser RolePermissions
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser RolePermissions)
-> String -> Parser RolePermissions
forall a b. (a -> b) -> a -> b
$ String
"invalid role permissions: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
text

newtype DiscordId a = DiscordId { forall a. DiscordId a -> Snowflake
unId :: Snowflake }
  deriving newtype (Eq (DiscordId a)
Eq (DiscordId a) =>
(DiscordId a -> DiscordId a -> Ordering)
-> (DiscordId a -> DiscordId a -> Bool)
-> (DiscordId a -> DiscordId a -> Bool)
-> (DiscordId a -> DiscordId a -> Bool)
-> (DiscordId a -> DiscordId a -> Bool)
-> (DiscordId a -> DiscordId a -> DiscordId a)
-> (DiscordId a -> DiscordId a -> DiscordId a)
-> Ord (DiscordId a)
DiscordId a -> DiscordId a -> Bool
DiscordId a -> DiscordId a -> Ordering
DiscordId a -> DiscordId a -> DiscordId a
forall a. Eq (DiscordId a)
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
forall a. DiscordId a -> DiscordId a -> Bool
forall a. DiscordId a -> DiscordId a -> Ordering
forall a. DiscordId a -> DiscordId a -> DiscordId a
$ccompare :: forall a. DiscordId a -> DiscordId a -> Ordering
compare :: DiscordId a -> DiscordId a -> Ordering
$c< :: forall a. DiscordId a -> DiscordId a -> Bool
< :: DiscordId a -> DiscordId a -> Bool
$c<= :: forall a. DiscordId a -> DiscordId a -> Bool
<= :: DiscordId a -> DiscordId a -> Bool
$c> :: forall a. DiscordId a -> DiscordId a -> Bool
> :: DiscordId a -> DiscordId a -> Bool
$c>= :: forall a. DiscordId a -> DiscordId a -> Bool
>= :: DiscordId a -> DiscordId a -> Bool
$cmax :: forall a. DiscordId a -> DiscordId a -> DiscordId a
max :: DiscordId a -> DiscordId a -> DiscordId a
$cmin :: forall a. DiscordId a -> DiscordId a -> DiscordId a
min :: DiscordId a -> DiscordId a -> DiscordId a
Ord, DiscordId a -> DiscordId a -> Bool
(DiscordId a -> DiscordId a -> Bool)
-> (DiscordId a -> DiscordId a -> Bool) -> Eq (DiscordId a)
forall a. DiscordId a -> DiscordId a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. DiscordId a -> DiscordId a -> Bool
== :: DiscordId a -> DiscordId a -> Bool
$c/= :: forall a. DiscordId a -> DiscordId a -> Bool
/= :: DiscordId a -> DiscordId a -> Bool
Eq, Eq (DiscordId a)
Eq (DiscordId a) =>
(Int -> DiscordId a -> Int)
-> (DiscordId a -> Int) -> Hashable (DiscordId a)
Int -> DiscordId a -> Int
DiscordId a -> Int
forall a. Eq (DiscordId a)
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Int -> DiscordId a -> Int
forall a. DiscordId a -> Int
$chashWithSalt :: forall a. Int -> DiscordId a -> Int
hashWithSalt :: Int -> DiscordId a -> Int
$chash :: forall a. DiscordId a -> Int
hash :: DiscordId a -> Int
Hashable, Int -> DiscordId a -> ShowS
[DiscordId a] -> ShowS
DiscordId a -> String
(Int -> DiscordId a -> ShowS)
-> (DiscordId a -> String)
-> ([DiscordId a] -> ShowS)
-> Show (DiscordId a)
forall a. Int -> DiscordId a -> ShowS
forall a. [DiscordId a] -> ShowS
forall a. DiscordId a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> DiscordId a -> ShowS
showsPrec :: Int -> DiscordId a -> ShowS
$cshow :: forall a. DiscordId a -> String
show :: DiscordId a -> String
$cshowList :: forall a. [DiscordId a] -> ShowS
showList :: [DiscordId a] -> ShowS
Show, ReadPrec [DiscordId a]
ReadPrec (DiscordId a)
Int -> ReadS (DiscordId a)
ReadS [DiscordId a]
(Int -> ReadS (DiscordId a))
-> ReadS [DiscordId a]
-> ReadPrec (DiscordId a)
-> ReadPrec [DiscordId a]
-> Read (DiscordId a)
forall a. ReadPrec [DiscordId a]
forall a. ReadPrec (DiscordId a)
forall a. Int -> ReadS (DiscordId a)
forall a. ReadS [DiscordId a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (DiscordId a)
readsPrec :: Int -> ReadS (DiscordId a)
$creadList :: forall a. ReadS [DiscordId a]
readList :: ReadS [DiscordId a]
$creadPrec :: forall a. ReadPrec (DiscordId a)
readPrec :: ReadPrec (DiscordId a)
$creadListPrec :: forall a. ReadPrec [DiscordId a]
readListPrec :: ReadPrec [DiscordId a]
Read, [DiscordId a] -> Value
[DiscordId a] -> Encoding
DiscordId a -> Bool
DiscordId a -> Value
DiscordId a -> Encoding
(DiscordId a -> Value)
-> (DiscordId a -> Encoding)
-> ([DiscordId a] -> Value)
-> ([DiscordId a] -> Encoding)
-> (DiscordId a -> Bool)
-> ToJSON (DiscordId a)
forall a. [DiscordId a] -> Value
forall a. [DiscordId a] -> Encoding
forall a. DiscordId a -> Bool
forall a. DiscordId a -> Value
forall a. DiscordId a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. DiscordId a -> Value
toJSON :: DiscordId a -> Value
$ctoEncoding :: forall a. DiscordId a -> Encoding
toEncoding :: DiscordId a -> Encoding
$ctoJSONList :: forall a. [DiscordId a] -> Value
toJSONList :: [DiscordId a] -> Value
$ctoEncodingList :: forall a. [DiscordId a] -> Encoding
toEncodingList :: [DiscordId a] -> Encoding
$comitField :: forall a. DiscordId a -> Bool
omitField :: DiscordId a -> Bool
ToJSON, ToJSONKeyFunction [DiscordId a]
ToJSONKeyFunction (DiscordId a)
ToJSONKeyFunction (DiscordId a)
-> ToJSONKeyFunction [DiscordId a] -> ToJSONKey (DiscordId a)
forall a. ToJSONKeyFunction [DiscordId a]
forall a. ToJSONKeyFunction (DiscordId a)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: forall a. ToJSONKeyFunction (DiscordId a)
toJSONKey :: ToJSONKeyFunction (DiscordId a)
$ctoJSONKeyList :: forall a. ToJSONKeyFunction [DiscordId a]
toJSONKeyList :: ToJSONKeyFunction [DiscordId a]
ToJSONKey, Maybe (DiscordId a)
Value -> Parser [DiscordId a]
Value -> Parser (DiscordId a)
(Value -> Parser (DiscordId a))
-> (Value -> Parser [DiscordId a])
-> Maybe (DiscordId a)
-> FromJSON (DiscordId a)
forall a. Maybe (DiscordId a)
forall a. Value -> Parser [DiscordId a]
forall a. Value -> Parser (DiscordId a)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall a. Value -> Parser (DiscordId a)
parseJSON :: Value -> Parser (DiscordId a)
$cparseJSONList :: forall a. Value -> Parser [DiscordId a]
parseJSONList :: Value -> Parser [DiscordId a]
$comittedField :: forall a. Maybe (DiscordId a)
omittedField :: Maybe (DiscordId a)
FromJSON, FromJSONKeyFunction [DiscordId a]
FromJSONKeyFunction (DiscordId a)
FromJSONKeyFunction (DiscordId a)
-> FromJSONKeyFunction [DiscordId a] -> FromJSONKey (DiscordId a)
forall a. FromJSONKeyFunction [DiscordId a]
forall a. FromJSONKeyFunction (DiscordId a)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: forall a. FromJSONKeyFunction (DiscordId a)
fromJSONKey :: FromJSONKeyFunction (DiscordId a)
$cfromJSONKeyList :: forall a. FromJSONKeyFunction [DiscordId a]
fromJSONKeyList :: FromJSONKeyFunction [DiscordId a]
FromJSONKey, DiscordId a -> Text
DiscordId a -> ByteString
DiscordId a -> Builder
(DiscordId a -> Text)
-> (DiscordId a -> Builder)
-> (DiscordId a -> ByteString)
-> (DiscordId a -> Text)
-> (DiscordId a -> Builder)
-> ToHttpApiData (DiscordId a)
forall a. DiscordId a -> Text
forall a. DiscordId a -> ByteString
forall a. DiscordId a -> Builder
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: forall a. DiscordId a -> Text
toUrlPiece :: DiscordId a -> Text
$ctoEncodedUrlPiece :: forall a. DiscordId a -> Builder
toEncodedUrlPiece :: DiscordId a -> Builder
$ctoHeader :: forall a. DiscordId a -> ByteString
toHeader :: DiscordId a -> ByteString
$ctoQueryParam :: forall a. DiscordId a -> Text
toQueryParam :: DiscordId a -> Text
$ctoEncodedQueryParam :: forall a. DiscordId a -> Builder
toEncodedQueryParam :: DiscordId a -> Builder
ToHttpApiData)

data ChannelIdType
type ChannelId = DiscordId ChannelIdType

data StageIdType
type StageId = DiscordId StageIdType

data GuildIdType
type GuildId = DiscordId GuildIdType

data MessageIdType
type MessageId = DiscordId MessageIdType

data AttachmentIdType
type AttachmentId = DiscordId AttachmentIdType

data EmojiIdType
type EmojiId = DiscordId EmojiIdType

data StickerIdType
type StickerId = DiscordId StickerIdType

data UserIdType
type UserId = DiscordId UserIdType

data RoleIdType
type RoleId = DiscordId RoleIdType

data DiscordTeamIdType
type DiscordTeamId = DiscordId DiscordTeamIdType

data GameSKUIdType
type GameSKUId = DiscordId GameSKUIdType

data IntegrationIdType
type IntegrationId = DiscordId IntegrationIdType

data WebhookIdType
type WebhookId = DiscordId WebhookIdType

data ParentIdType
type ParentId = DiscordId ParentIdType

data ApplicationIdType
type ApplicationId = DiscordId ApplicationIdType

data ApplicationCommandIdType
type ApplicationCommandId = DiscordId ApplicationCommandIdType

data InteractionIdType
type InteractionId = DiscordId InteractionIdType

data ScheduledEventIdType
type ScheduledEventId = DiscordId ScheduledEventIdType

data ScheduledEventEntityIdType
type ScheduledEventEntityId = DiscordId ScheduledEventEntityIdType

data AuditLogEntryIdType
type AuditLogEntryId = DiscordId AuditLogEntryIdType

data AutoModerationRuleIdType
type AutoModerationRuleId = DiscordId AutoModerationRuleIdType

newtype DiscordToken a = DiscordToken { forall a. DiscordToken a -> Text
unToken :: T.Text }
  deriving newtype (Eq (DiscordToken a)
Eq (DiscordToken a) =>
(DiscordToken a -> DiscordToken a -> Ordering)
-> (DiscordToken a -> DiscordToken a -> Bool)
-> (DiscordToken a -> DiscordToken a -> Bool)
-> (DiscordToken a -> DiscordToken a -> Bool)
-> (DiscordToken a -> DiscordToken a -> Bool)
-> (DiscordToken a -> DiscordToken a -> DiscordToken a)
-> (DiscordToken a -> DiscordToken a -> DiscordToken a)
-> Ord (DiscordToken a)
DiscordToken a -> DiscordToken a -> Bool
DiscordToken a -> DiscordToken a -> Ordering
DiscordToken a -> DiscordToken a -> DiscordToken a
forall a. Eq (DiscordToken a)
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
forall a. DiscordToken a -> DiscordToken a -> Bool
forall a. DiscordToken a -> DiscordToken a -> Ordering
forall a. DiscordToken a -> DiscordToken a -> DiscordToken a
$ccompare :: forall a. DiscordToken a -> DiscordToken a -> Ordering
compare :: DiscordToken a -> DiscordToken a -> Ordering
$c< :: forall a. DiscordToken a -> DiscordToken a -> Bool
< :: DiscordToken a -> DiscordToken a -> Bool
$c<= :: forall a. DiscordToken a -> DiscordToken a -> Bool
<= :: DiscordToken a -> DiscordToken a -> Bool
$c> :: forall a. DiscordToken a -> DiscordToken a -> Bool
> :: DiscordToken a -> DiscordToken a -> Bool
$c>= :: forall a. DiscordToken a -> DiscordToken a -> Bool
>= :: DiscordToken a -> DiscordToken a -> Bool
$cmax :: forall a. DiscordToken a -> DiscordToken a -> DiscordToken a
max :: DiscordToken a -> DiscordToken a -> DiscordToken a
$cmin :: forall a. DiscordToken a -> DiscordToken a -> DiscordToken a
min :: DiscordToken a -> DiscordToken a -> DiscordToken a
Ord, DiscordToken a -> DiscordToken a -> Bool
(DiscordToken a -> DiscordToken a -> Bool)
-> (DiscordToken a -> DiscordToken a -> Bool)
-> Eq (DiscordToken a)
forall a. DiscordToken a -> DiscordToken a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. DiscordToken a -> DiscordToken a -> Bool
== :: DiscordToken a -> DiscordToken a -> Bool
$c/= :: forall a. DiscordToken a -> DiscordToken a -> Bool
/= :: DiscordToken a -> DiscordToken a -> Bool
Eq, Int -> DiscordToken a -> ShowS
[DiscordToken a] -> ShowS
DiscordToken a -> String
(Int -> DiscordToken a -> ShowS)
-> (DiscordToken a -> String)
-> ([DiscordToken a] -> ShowS)
-> Show (DiscordToken a)
forall a. Int -> DiscordToken a -> ShowS
forall a. [DiscordToken a] -> ShowS
forall a. DiscordToken a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> DiscordToken a -> ShowS
showsPrec :: Int -> DiscordToken a -> ShowS
$cshow :: forall a. DiscordToken a -> String
show :: DiscordToken a -> String
$cshowList :: forall a. [DiscordToken a] -> ShowS
showList :: [DiscordToken a] -> ShowS
Show, ReadPrec [DiscordToken a]
ReadPrec (DiscordToken a)
Int -> ReadS (DiscordToken a)
ReadS [DiscordToken a]
(Int -> ReadS (DiscordToken a))
-> ReadS [DiscordToken a]
-> ReadPrec (DiscordToken a)
-> ReadPrec [DiscordToken a]
-> Read (DiscordToken a)
forall a. ReadPrec [DiscordToken a]
forall a. ReadPrec (DiscordToken a)
forall a. Int -> ReadS (DiscordToken a)
forall a. ReadS [DiscordToken a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (DiscordToken a)
readsPrec :: Int -> ReadS (DiscordToken a)
$creadList :: forall a. ReadS [DiscordToken a]
readList :: ReadS [DiscordToken a]
$creadPrec :: forall a. ReadPrec (DiscordToken a)
readPrec :: ReadPrec (DiscordToken a)
$creadListPrec :: forall a. ReadPrec [DiscordToken a]
readListPrec :: ReadPrec [DiscordToken a]
Read, [DiscordToken a] -> Value
[DiscordToken a] -> Encoding
DiscordToken a -> Bool
DiscordToken a -> Value
DiscordToken a -> Encoding
(DiscordToken a -> Value)
-> (DiscordToken a -> Encoding)
-> ([DiscordToken a] -> Value)
-> ([DiscordToken a] -> Encoding)
-> (DiscordToken a -> Bool)
-> ToJSON (DiscordToken a)
forall a. [DiscordToken a] -> Value
forall a. [DiscordToken a] -> Encoding
forall a. DiscordToken a -> Bool
forall a. DiscordToken a -> Value
forall a. DiscordToken a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. DiscordToken a -> Value
toJSON :: DiscordToken a -> Value
$ctoEncoding :: forall a. DiscordToken a -> Encoding
toEncoding :: DiscordToken a -> Encoding
$ctoJSONList :: forall a. [DiscordToken a] -> Value
toJSONList :: [DiscordToken a] -> Value
$ctoEncodingList :: forall a. [DiscordToken a] -> Encoding
toEncodingList :: [DiscordToken a] -> Encoding
$comitField :: forall a. DiscordToken a -> Bool
omitField :: DiscordToken a -> Bool
ToJSON, Maybe (DiscordToken a)
Value -> Parser [DiscordToken a]
Value -> Parser (DiscordToken a)
(Value -> Parser (DiscordToken a))
-> (Value -> Parser [DiscordToken a])
-> Maybe (DiscordToken a)
-> FromJSON (DiscordToken a)
forall a. Maybe (DiscordToken a)
forall a. Value -> Parser [DiscordToken a]
forall a. Value -> Parser (DiscordToken a)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall a. Value -> Parser (DiscordToken a)
parseJSON :: Value -> Parser (DiscordToken a)
$cparseJSONList :: forall a. Value -> Parser [DiscordToken a]
parseJSONList :: Value -> Parser [DiscordToken a]
$comittedField :: forall a. Maybe (DiscordToken a)
omittedField :: Maybe (DiscordToken a)
FromJSON, DiscordToken a -> Text
DiscordToken a -> ByteString
DiscordToken a -> Builder
(DiscordToken a -> Text)
-> (DiscordToken a -> Builder)
-> (DiscordToken a -> ByteString)
-> (DiscordToken a -> Text)
-> (DiscordToken a -> Builder)
-> ToHttpApiData (DiscordToken a)
forall a. DiscordToken a -> Text
forall a. DiscordToken a -> ByteString
forall a. DiscordToken a -> Builder
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: forall a. DiscordToken a -> Text
toUrlPiece :: DiscordToken a -> Text
$ctoEncodedUrlPiece :: forall a. DiscordToken a -> Builder
toEncodedUrlPiece :: DiscordToken a -> Builder
$ctoHeader :: forall a. DiscordToken a -> ByteString
toHeader :: DiscordToken a -> ByteString
$ctoQueryParam :: forall a. DiscordToken a -> Text
toQueryParam :: DiscordToken a -> Text
$ctoEncodedQueryParam :: forall a. DiscordToken a -> Builder
toEncodedQueryParam :: DiscordToken a -> Builder
ToHttpApiData)

type InteractionToken = DiscordToken InteractionIdType

type WebhookToken = DiscordToken WebhookIdType

type Shard = (Int, Int)

-- | Gets a creation date from a snowflake.
snowflakeCreationDate :: Snowflake -> UTCTime
snowflakeCreationDate :: Snowflake -> UTCTime
snowflakeCreationDate (Snowflake Word64
x) = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Word64 -> POSIXTime) -> Word64 -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  (Word64 -> UTCTime) -> Word64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Word64
1420070400 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
quot (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
x Int
22) Word64
1000

-- | Default timestamp
epochTime :: UTCTime
epochTime :: UTCTime
epochTime = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0

{-

InternalDiscordEnum is a hack-y typeclass, but it's the best solution overall.
The best we can do is prevent the end-user from seeing this.

typeclass Bounded (minBound + maxBound) could replace discordTypeStartValue, but
it can't derive instances for types like DiscordColor, which have simple sum types involved.

typeclass Enum (toEnum + fromEnum) requires defining both A->Int and Int->A.
If we handle both at once (with an inline map), it's no longer typesafe.

External packages exist, but bloat our dependencies

-}
class Data a => InternalDiscordEnum a where
  discordTypeStartValue :: a
  fromDiscordType :: a -> Int
  discordTypeTable :: [(Int, a)]
  discordTypeTable =  (a -> (Int, a)) -> [a] -> [(Int, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
d -> (a -> Int
forall a. InternalDiscordEnum a => a -> Int
fromDiscordType a
d, a
d)) (a -> [a]
forall b. Data b => b -> [b]
makeTable a
forall a. InternalDiscordEnum a => a
discordTypeStartValue)
    where
      makeTable :: Data b => b -> [b]
      makeTable :: forall b. Data b => b -> [b]
makeTable b
t = (Constr -> b) -> [Constr] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Constr -> b
forall a. Data a => Constr -> a
fromConstr (DataType -> [Constr]
dataTypeConstrs (DataType -> [Constr]) -> DataType -> [Constr]
forall a b. (a -> b) -> a -> b
$ b -> DataType
forall a. Data a => a -> DataType
dataTypeOf b
t)

  discordTypeParseJSON :: String -> Value -> Parser a
  discordTypeParseJSON String
name =
    String -> (Scientific -> Parser a) -> Value -> Parser a
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific
      String
name
      ( \Scientific
i -> do
          case Scientific -> Maybe Int
forall {a} {a}. (RealFrac a, Integral a) => a -> Maybe a
maybeInt Scientific
i Maybe Int -> (Int -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> [(Int, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Int, a)]
forall a. InternalDiscordEnum a => [(Int, a)]
discordTypeTable) of
            Maybe a
Nothing -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"could not parse type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
i
            Just a
d -> a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
      )
    where
      maybeInt :: a -> Maybe a
maybeInt a
i
        | Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
i) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
i
        | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

(.==) :: ToJSON a => Key.Key -> a -> Maybe Pair
Key
k .== :: forall a. ToJSON a => Key -> a -> Maybe Pair
.== a
v = Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
k Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
v)

(.=?) :: ToJSON a => Key.Key -> Maybe a -> Maybe Pair
Key
k .=? :: forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? (Just a
v) = Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Key
k Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
v)
Key
_ .=? Maybe a
Nothing = Maybe Pair
forall a. Maybe a
Nothing

objectFromMaybes :: [Maybe Pair] -> Value
objectFromMaybes :: [Maybe Pair] -> Value
objectFromMaybes = [Pair] -> Value
object ([Pair] -> Value)
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes


-- | @Base64Image mime data@ represents the base64 encoding of an image (as
-- @data@), together with a tag of its mime type (@mime@).  The constructor is
-- only for Internal use, and its public export is hidden in Discord.Types.
--
-- Public creation of this datatype should be done using the relevant smart
-- constructors for Emoji, Sticker, or Avatar.
data Base64Image a = Base64Image { forall a. Base64Image a -> Text
mimeType :: T.Text, forall a. Base64Image a -> ByteString
base64Data :: B.ByteString }
  deriving (Int -> Base64Image a -> ShowS
[Base64Image a] -> ShowS
Base64Image a -> String
(Int -> Base64Image a -> ShowS)
-> (Base64Image a -> String)
-> ([Base64Image a] -> ShowS)
-> Show (Base64Image a)
forall a. Int -> Base64Image a -> ShowS
forall a. [Base64Image a] -> ShowS
forall a. Base64Image a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Base64Image a -> ShowS
showsPrec :: Int -> Base64Image a -> ShowS
$cshow :: forall a. Base64Image a -> String
show :: Base64Image a -> String
$cshowList :: forall a. [Base64Image a] -> ShowS
showList :: [Base64Image a] -> ShowS
Show, ReadPrec [Base64Image a]
ReadPrec (Base64Image a)
Int -> ReadS (Base64Image a)
ReadS [Base64Image a]
(Int -> ReadS (Base64Image a))
-> ReadS [Base64Image a]
-> ReadPrec (Base64Image a)
-> ReadPrec [Base64Image a]
-> Read (Base64Image a)
forall a. ReadPrec [Base64Image a]
forall a. ReadPrec (Base64Image a)
forall a. Int -> ReadS (Base64Image a)
forall a. ReadS [Base64Image a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (Base64Image a)
readsPrec :: Int -> ReadS (Base64Image a)
$creadList :: forall a. ReadS [Base64Image a]
readList :: ReadS [Base64Image a]
$creadPrec :: forall a. ReadPrec (Base64Image a)
readPrec :: ReadPrec (Base64Image a)
$creadListPrec :: forall a. ReadPrec [Base64Image a]
readListPrec :: ReadPrec [Base64Image a]
Read, Base64Image a -> Base64Image a -> Bool
(Base64Image a -> Base64Image a -> Bool)
-> (Base64Image a -> Base64Image a -> Bool) -> Eq (Base64Image a)
forall a. Base64Image a -> Base64Image a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Base64Image a -> Base64Image a -> Bool
== :: Base64Image a -> Base64Image a -> Bool
$c/= :: forall a. Base64Image a -> Base64Image a -> Bool
/= :: Base64Image a -> Base64Image a -> Bool
Eq, Eq (Base64Image a)
Eq (Base64Image a) =>
(Base64Image a -> Base64Image a -> Ordering)
-> (Base64Image a -> Base64Image a -> Bool)
-> (Base64Image a -> Base64Image a -> Bool)
-> (Base64Image a -> Base64Image a -> Bool)
-> (Base64Image a -> Base64Image a -> Bool)
-> (Base64Image a -> Base64Image a -> Base64Image a)
-> (Base64Image a -> Base64Image a -> Base64Image a)
-> Ord (Base64Image a)
Base64Image a -> Base64Image a -> Bool
Base64Image a -> Base64Image a -> Ordering
Base64Image a -> Base64Image a -> Base64Image a
forall a. Eq (Base64Image a)
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
forall a. Base64Image a -> Base64Image a -> Bool
forall a. Base64Image a -> Base64Image a -> Ordering
forall a. Base64Image a -> Base64Image a -> Base64Image a
$ccompare :: forall a. Base64Image a -> Base64Image a -> Ordering
compare :: Base64Image a -> Base64Image a -> Ordering
$c< :: forall a. Base64Image a -> Base64Image a -> Bool
< :: Base64Image a -> Base64Image a -> Bool
$c<= :: forall a. Base64Image a -> Base64Image a -> Bool
<= :: Base64Image a -> Base64Image a -> Bool
$c> :: forall a. Base64Image a -> Base64Image a -> Bool
> :: Base64Image a -> Base64Image a -> Bool
$c>= :: forall a. Base64Image a -> Base64Image a -> Bool
>= :: Base64Image a -> Base64Image a -> Bool
$cmax :: forall a. Base64Image a -> Base64Image a -> Base64Image a
max :: Base64Image a -> Base64Image a -> Base64Image a
$cmin :: forall a. Base64Image a -> Base64Image a -> Base64Image a
min :: Base64Image a -> Base64Image a -> Base64Image a
Ord)

-- | The ToJSON instance for Base64Image creates a string representation of the
-- image's base-64 data, suited for using as JSON values.
--
-- The format is: @data:%MIME%;base64,%DATA%@.
instance ToJSON (Base64Image a) where
  toJSON :: Base64Image a -> Value
toJSON (Base64Image Text
mime ByteString
im) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"data:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mime Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";base64," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.E.decodeUtf8 ByteString
im

-- | @getMimeType bs@ returns a possible mimetype for the given bytestring,
-- based on the first few magic bytes. It may return any of PNG/JPEG/GIF or WEBP
-- mimetypes, or Nothing if none are matched.
--
-- Reference: https://en.wikipedia.org/wiki/List_of_file_signatures
--
-- Although Discord's official documentation does not state WEBP as a supported
-- format, it has been accepted for both emojis and user avatars no problem
-- when tested manually.
--
-- /Inspired by discord.py's implementation./
getMimeType :: B.ByteString -> Maybe T.Text
getMimeType :: ByteString -> Maybe Text
getMimeType ByteString
bs
  | Int -> ByteString -> ByteString
B.take Int
8 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\x89\x50\x4E\x47\x0D\x0A\x1A\x0A"
      = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/png"
  | Int -> ByteString -> ByteString
B.take Int
3 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\xff\xd8\xff" Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
6 ByteString
bs) ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"JFIF", ByteString
"Exif"]
      = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/jpeg"
  | Int -> ByteString -> ByteString
B.take Int
6 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\x47\x49\x46\x38\x37\x61" Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
B.take Int
6 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\x47\x49\x46\x38\x39\x61"
      = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/gif"
  | Int -> ByteString -> ByteString
B.take Int
4 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"RIFF" Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
B.take Int
4 (Int -> ByteString -> ByteString
B.drop Int
8 ByteString
bs) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"WEBP"
      = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/webp"
  | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

-- | The different channel types. Used for application commands and components.
--
-- https://discord.com/developers/docs/resources/channel#channel-object-channel-types
data ChannelTypeOption
  = -- | A text channel in a server.
    ChannelTypeOptionGuildText
  | -- | A direct message between users.
    ChannelTypeOptionDM
  | -- | A voice channel in a server.
    ChannelTypeOptionGuildVoice
  | -- | A direct message between multiple users.
    ChannelTypeOptionGroupDM
  | -- | An organizational category that contains up to 50 channels.
    ChannelTypeOptionGuildCategory
  | -- | A channel that users can follow and crosspost into their own server.
    ChannelTypeOptionGuildNews
  | -- | A channel in which game developers can sell their game on discord.
    ChannelTypeOptionGuildStore
  | -- | A temporary sub-channel within a guild_news channel.
    ChannelTypeOptionGuildNewsThread
  | -- | A temporary sub-channel within a guild_text channel.
    ChannelTypeOptionGuildPublicThread
  | -- | A temporary sub-channel within a GUILD_TEXT channel that is only
    -- viewable by those invited and those with the MANAGE_THREADS permission
    ChannelTypeOptionGuildPrivateThread
  | -- | A voice channel for hosting events with an audience.
    ChannelTypeOptionGuildStageVoice
  deriving (Int -> ChannelTypeOption -> ShowS
[ChannelTypeOption] -> ShowS
ChannelTypeOption -> String
(Int -> ChannelTypeOption -> ShowS)
-> (ChannelTypeOption -> String)
-> ([ChannelTypeOption] -> ShowS)
-> Show ChannelTypeOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChannelTypeOption -> ShowS
showsPrec :: Int -> ChannelTypeOption -> ShowS
$cshow :: ChannelTypeOption -> String
show :: ChannelTypeOption -> String
$cshowList :: [ChannelTypeOption] -> ShowS
showList :: [ChannelTypeOption] -> ShowS
Show, ReadPrec [ChannelTypeOption]
ReadPrec ChannelTypeOption
Int -> ReadS ChannelTypeOption
ReadS [ChannelTypeOption]
(Int -> ReadS ChannelTypeOption)
-> ReadS [ChannelTypeOption]
-> ReadPrec ChannelTypeOption
-> ReadPrec [ChannelTypeOption]
-> Read ChannelTypeOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChannelTypeOption
readsPrec :: Int -> ReadS ChannelTypeOption
$creadList :: ReadS [ChannelTypeOption]
readList :: ReadS [ChannelTypeOption]
$creadPrec :: ReadPrec ChannelTypeOption
readPrec :: ReadPrec ChannelTypeOption
$creadListPrec :: ReadPrec [ChannelTypeOption]
readListPrec :: ReadPrec [ChannelTypeOption]
Read, Typeable ChannelTypeOption
Typeable ChannelTypeOption =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ChannelTypeOption
 -> c ChannelTypeOption)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ChannelTypeOption)
-> (ChannelTypeOption -> Constr)
-> (ChannelTypeOption -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ChannelTypeOption))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ChannelTypeOption))
-> ((forall b. Data b => b -> b)
    -> ChannelTypeOption -> ChannelTypeOption)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ChannelTypeOption -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ChannelTypeOption -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ChannelTypeOption -> m ChannelTypeOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChannelTypeOption -> m ChannelTypeOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ChannelTypeOption -> m ChannelTypeOption)
-> Data ChannelTypeOption
ChannelTypeOption -> Constr
ChannelTypeOption -> DataType
(forall b. Data b => b -> b)
-> ChannelTypeOption -> ChannelTypeOption
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) -> ChannelTypeOption -> u
forall u. (forall d. Data d => d -> u) -> ChannelTypeOption -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChannelTypeOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChannelTypeOption -> c ChannelTypeOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChannelTypeOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChannelTypeOption)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChannelTypeOption -> c ChannelTypeOption
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ChannelTypeOption -> c ChannelTypeOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChannelTypeOption
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ChannelTypeOption
$ctoConstr :: ChannelTypeOption -> Constr
toConstr :: ChannelTypeOption -> Constr
$cdataTypeOf :: ChannelTypeOption -> DataType
dataTypeOf :: ChannelTypeOption -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChannelTypeOption)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ChannelTypeOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChannelTypeOption)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ChannelTypeOption)
$cgmapT :: (forall b. Data b => b -> b)
-> ChannelTypeOption -> ChannelTypeOption
gmapT :: (forall b. Data b => b -> b)
-> ChannelTypeOption -> ChannelTypeOption
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ChannelTypeOption -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ChannelTypeOption -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ChannelTypeOption -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChannelTypeOption -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ChannelTypeOption -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ChannelTypeOption -> m ChannelTypeOption
Data, ChannelTypeOption -> ChannelTypeOption -> Bool
(ChannelTypeOption -> ChannelTypeOption -> Bool)
-> (ChannelTypeOption -> ChannelTypeOption -> Bool)
-> Eq ChannelTypeOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChannelTypeOption -> ChannelTypeOption -> Bool
== :: ChannelTypeOption -> ChannelTypeOption -> Bool
$c/= :: ChannelTypeOption -> ChannelTypeOption -> Bool
/= :: ChannelTypeOption -> ChannelTypeOption -> Bool
Eq, Eq ChannelTypeOption
Eq ChannelTypeOption =>
(ChannelTypeOption -> ChannelTypeOption -> Ordering)
-> (ChannelTypeOption -> ChannelTypeOption -> Bool)
-> (ChannelTypeOption -> ChannelTypeOption -> Bool)
-> (ChannelTypeOption -> ChannelTypeOption -> Bool)
-> (ChannelTypeOption -> ChannelTypeOption -> Bool)
-> (ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption)
-> (ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption)
-> Ord ChannelTypeOption
ChannelTypeOption -> ChannelTypeOption -> Bool
ChannelTypeOption -> ChannelTypeOption -> Ordering
ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption
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
$ccompare :: ChannelTypeOption -> ChannelTypeOption -> Ordering
compare :: ChannelTypeOption -> ChannelTypeOption -> Ordering
$c< :: ChannelTypeOption -> ChannelTypeOption -> Bool
< :: ChannelTypeOption -> ChannelTypeOption -> Bool
$c<= :: ChannelTypeOption -> ChannelTypeOption -> Bool
<= :: ChannelTypeOption -> ChannelTypeOption -> Bool
$c> :: ChannelTypeOption -> ChannelTypeOption -> Bool
> :: ChannelTypeOption -> ChannelTypeOption -> Bool
$c>= :: ChannelTypeOption -> ChannelTypeOption -> Bool
>= :: ChannelTypeOption -> ChannelTypeOption -> Bool
$cmax :: ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption
max :: ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption
$cmin :: ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption
min :: ChannelTypeOption -> ChannelTypeOption -> ChannelTypeOption
Ord)

instance InternalDiscordEnum ChannelTypeOption where
  discordTypeStartValue :: ChannelTypeOption
discordTypeStartValue = ChannelTypeOption
ChannelTypeOptionGuildText
  fromDiscordType :: ChannelTypeOption -> Int
fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildText = Int
0
  fromDiscordType ChannelTypeOption
ChannelTypeOptionDM = Int
1
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildVoice = Int
2
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGroupDM = Int
3
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildCategory = Int
4
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildNews = Int
5
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildStore = Int
6
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildNewsThread = Int
10
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildPublicThread = Int
11
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildPrivateThread = Int
12
  fromDiscordType ChannelTypeOption
ChannelTypeOptionGuildStageVoice = Int
13

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

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