{-# LANGUAGE OverloadedStrings #-}

-- | Types relating to Discord Guilds (servers)
module Discord.Internal.Types.Guild where

import Data.Time.Clock

import Data.Aeson
import qualified Data.Text as T

import Discord.Internal.Types.Prelude
import Discord.Internal.Types.Channel (Channel, Emoji)
import Discord.Internal.Types.User (User)

-- | Representation of a guild member.
data GuildMember = GuildMember
      { GuildMember -> User
memberUser     :: User
      , GuildMember -> Maybe Text
memberNick     :: Maybe T.Text
      , GuildMember -> [Snowflake]
memberRoles    :: [Snowflake]
      , GuildMember -> UTCTime
memberJoinedAt :: UTCTime
      , GuildMember -> Bool
memberDeaf     :: Bool
      , GuildMember -> Bool
memberMute     :: Bool
      } deriving (Int -> GuildMember -> ShowS
[GuildMember] -> ShowS
GuildMember -> String
(Int -> GuildMember -> ShowS)
-> (GuildMember -> String)
-> ([GuildMember] -> ShowS)
-> Show GuildMember
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildMember] -> ShowS
$cshowList :: [GuildMember] -> ShowS
show :: GuildMember -> String
$cshow :: GuildMember -> String
showsPrec :: Int -> GuildMember -> ShowS
$cshowsPrec :: Int -> GuildMember -> ShowS
Show, GuildMember -> GuildMember -> Bool
(GuildMember -> GuildMember -> Bool)
-> (GuildMember -> GuildMember -> Bool) -> Eq GuildMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildMember -> GuildMember -> Bool
$c/= :: GuildMember -> GuildMember -> Bool
== :: GuildMember -> GuildMember -> Bool
$c== :: GuildMember -> GuildMember -> Bool
Eq, Eq GuildMember
Eq GuildMember
-> (GuildMember -> GuildMember -> Ordering)
-> (GuildMember -> GuildMember -> Bool)
-> (GuildMember -> GuildMember -> Bool)
-> (GuildMember -> GuildMember -> Bool)
-> (GuildMember -> GuildMember -> Bool)
-> (GuildMember -> GuildMember -> GuildMember)
-> (GuildMember -> GuildMember -> GuildMember)
-> Ord GuildMember
GuildMember -> GuildMember -> Bool
GuildMember -> GuildMember -> Ordering
GuildMember -> GuildMember -> GuildMember
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 :: GuildMember -> GuildMember -> GuildMember
$cmin :: GuildMember -> GuildMember -> GuildMember
max :: GuildMember -> GuildMember -> GuildMember
$cmax :: GuildMember -> GuildMember -> GuildMember
>= :: GuildMember -> GuildMember -> Bool
$c>= :: GuildMember -> GuildMember -> Bool
> :: GuildMember -> GuildMember -> Bool
$c> :: GuildMember -> GuildMember -> Bool
<= :: GuildMember -> GuildMember -> Bool
$c<= :: GuildMember -> GuildMember -> Bool
< :: GuildMember -> GuildMember -> Bool
$c< :: GuildMember -> GuildMember -> Bool
compare :: GuildMember -> GuildMember -> Ordering
$ccompare :: GuildMember -> GuildMember -> Ordering
$cp1Ord :: Eq GuildMember
Ord)

instance FromJSON GuildMember where
  parseJSON :: Value -> Parser GuildMember
parseJSON = String
-> (Object -> Parser GuildMember) -> Value -> Parser GuildMember
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildMember" ((Object -> Parser GuildMember) -> Value -> Parser GuildMember)
-> (Object -> Parser GuildMember) -> Value -> Parser GuildMember
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    User
-> Maybe Text
-> [Snowflake]
-> UTCTime
-> Bool
-> Bool
-> GuildMember
GuildMember (User
 -> Maybe Text
 -> [Snowflake]
 -> UTCTime
 -> Bool
 -> Bool
 -> GuildMember)
-> Parser User
-> Parser
     (Maybe Text
      -> [Snowflake] -> UTCTime -> Bool -> Bool -> GuildMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"user"
                Parser
  (Maybe Text
   -> [Snowflake] -> UTCTime -> Bool -> Bool -> GuildMember)
-> Parser (Maybe Text)
-> Parser ([Snowflake] -> UTCTime -> Bool -> Bool -> GuildMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"nick"
                Parser ([Snowflake] -> UTCTime -> Bool -> Bool -> GuildMember)
-> Parser [Snowflake]
-> Parser (UTCTime -> Bool -> Bool -> GuildMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Snowflake]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roles"
                Parser (UTCTime -> Bool -> Bool -> GuildMember)
-> Parser UTCTime -> Parser (Bool -> Bool -> GuildMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"joined_at"
                Parser (Bool -> Bool -> GuildMember)
-> Parser Bool -> Parser (Bool -> GuildMember)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"deaf"
                Parser (Bool -> GuildMember) -> Parser Bool -> Parser GuildMember
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"mute"


-- https://discord.com/developers/docs/resources/guild#guild-object

-- | Guilds in Discord represent a collection of users and channels into an isolated
--   "Server"
data Guild = Guild
      { Guild -> Snowflake
guildId                  :: GuildId       -- ^ Gulid id
      , Guild -> Text
guildName                :: T.Text          -- ^ Guild name (2 - 100 chars)
      , Guild -> Maybe Text
guildIcon                :: Maybe T.Text    -- ^ Icon hash
      , Guild -> Maybe Text
guildSplash              :: Maybe T.Text    -- ^ Splash hash
      , Guild -> Snowflake
guildOwnerId             :: UserId       -- ^ Guild owner id
      , Guild -> Maybe Integer
guildPermissions         :: Maybe Integer
      , Guild -> Text
guildRegion              :: T.Text          -- ^ Guild voice region
      , Guild -> Maybe Snowflake
guildAfkId               :: Maybe ChannelId -- ^ Id of afk channel
      , Guild -> Integer
guildAfkTimeout          :: Integer         -- ^ Afk timeout in seconds
      , Guild -> Maybe Bool
guildEmbedEnabled        :: Maybe Bool      -- ^ Id of embedded channel
      , Guild -> Maybe Snowflake
guildEmbedChannel        :: Maybe ChannelId -- ^ Id of embedded channel
      , Guild -> Integer
guildVerificationLevel   :: Integer         -- ^ Level of verification
      , Guild -> Integer
guildNotification        :: Integer         -- ^ Level of default notifications
      , Guild -> Integer
guildExplicitFilterLevel :: Integer
      , Guild -> [Role]
guildRoles               :: [Role]           -- ^ Array of 'Role' objects
      , Guild -> [Emoji]
guildEmojis              :: [Emoji]          -- ^ Array of 'Emoji' objects
      , Guild -> [Text]
guildFeatures            :: [T.Text]
      , Guild -> Integer
guildMultiFactAuth       :: !Integer
      , Guild -> Maybe Snowflake
guildApplicationId       :: Maybe Snowflake
      } deriving (Int -> Guild -> ShowS
[Guild] -> ShowS
Guild -> String
(Int -> Guild -> ShowS)
-> (Guild -> String) -> ([Guild] -> ShowS) -> Show Guild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Guild] -> ShowS
$cshowList :: [Guild] -> ShowS
show :: Guild -> String
$cshow :: Guild -> String
showsPrec :: Int -> Guild -> ShowS
$cshowsPrec :: Int -> Guild -> ShowS
Show, Guild -> Guild -> Bool
(Guild -> Guild -> Bool) -> (Guild -> Guild -> Bool) -> Eq Guild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Guild -> Guild -> Bool
$c/= :: Guild -> Guild -> Bool
== :: Guild -> Guild -> Bool
$c== :: Guild -> Guild -> Bool
Eq, Eq Guild
Eq Guild
-> (Guild -> Guild -> Ordering)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Bool)
-> (Guild -> Guild -> Guild)
-> (Guild -> Guild -> Guild)
-> Ord Guild
Guild -> Guild -> Bool
Guild -> Guild -> Ordering
Guild -> Guild -> Guild
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 :: Guild -> Guild -> Guild
$cmin :: Guild -> Guild -> Guild
max :: Guild -> Guild -> Guild
$cmax :: Guild -> Guild -> Guild
>= :: Guild -> Guild -> Bool
$c>= :: Guild -> Guild -> Bool
> :: Guild -> Guild -> Bool
$c> :: Guild -> Guild -> Bool
<= :: Guild -> Guild -> Bool
$c<= :: Guild -> Guild -> Bool
< :: Guild -> Guild -> Bool
$c< :: Guild -> Guild -> Bool
compare :: Guild -> Guild -> Ordering
$ccompare :: Guild -> Guild -> Ordering
$cp1Ord :: Eq Guild
Ord)

instance FromJSON Guild where
  parseJSON :: Value -> Parser Guild
parseJSON = String -> (Object -> Parser Guild) -> Value -> Parser Guild
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Guild" ((Object -> Parser Guild) -> Value -> Parser Guild)
-> (Object -> Parser Guild) -> Value -> Parser Guild
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Snowflake
-> Text
-> Maybe Text
-> Maybe Text
-> Snowflake
-> Maybe Integer
-> Text
-> Maybe Snowflake
-> Integer
-> Maybe Bool
-> Maybe Snowflake
-> Integer
-> Integer
-> Integer
-> [Role]
-> [Emoji]
-> [Text]
-> Integer
-> Maybe Snowflake
-> Guild
Guild (Snowflake
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Snowflake
 -> Maybe Integer
 -> Text
 -> Maybe Snowflake
 -> Integer
 -> Maybe Bool
 -> Maybe Snowflake
 -> Integer
 -> Integer
 -> Integer
 -> [Role]
 -> [Emoji]
 -> [Text]
 -> Integer
 -> Maybe Snowflake
 -> Guild)
-> Parser Snowflake
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Snowflake
      -> Maybe Integer
      -> Text
      -> Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id"
          Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Snowflake
   -> Maybe Integer
   -> Text
   -> Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Snowflake
      -> Maybe Integer
      -> Text
      -> Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name"
          Parser
  (Maybe Text
   -> Maybe Text
   -> Snowflake
   -> Maybe Integer
   -> Text
   -> Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Snowflake
      -> Maybe Integer
      -> Text
      -> Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"icon"
          Parser
  (Maybe Text
   -> Snowflake
   -> Maybe Integer
   -> Text
   -> Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Snowflake
      -> Maybe Integer
      -> Text
      -> Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"splash"
          Parser
  (Snowflake
   -> Maybe Integer
   -> Text
   -> Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Snowflake
-> Parser
     (Maybe Integer
      -> Text
      -> Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"owner_id"
          Parser
  (Maybe Integer
   -> Text
   -> Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser (Maybe Integer)
-> Parser
     (Text
      -> Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"permissions"
          Parser
  (Text
   -> Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Text
-> Parser
     (Maybe Snowflake
      -> Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"region"
          Parser
  (Maybe Snowflake
   -> Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser (Maybe Snowflake)
-> Parser
     (Integer
      -> Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Snowflake)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"afk_channel_id"
          Parser
  (Integer
   -> Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Integer
-> Parser
     (Maybe Bool
      -> Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"afk_timeout"
          Parser
  (Maybe Bool
   -> Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Snowflake
      -> Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"embed_enabled"
          Parser
  (Maybe Snowflake
   -> Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser (Maybe Snowflake)
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Snowflake)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"embed_channel_id"
          Parser
  (Integer
   -> Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"verification_level"
          Parser
  (Integer
   -> Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Integer
-> Parser
     (Integer
      -> [Role]
      -> [Emoji]
      -> [Text]
      -> Integer
      -> Maybe Snowflake
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"default_message_notifications"
          Parser
  (Integer
   -> [Role]
   -> [Emoji]
   -> [Text]
   -> Integer
   -> Maybe Snowflake
   -> Guild)
-> Parser Integer
-> Parser
     ([Role]
      -> [Emoji] -> [Text] -> Integer -> Maybe Snowflake -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"explicit_content_filter"
          Parser
  ([Role]
   -> [Emoji] -> [Text] -> Integer -> Maybe Snowflake -> Guild)
-> Parser [Role]
-> Parser
     ([Emoji] -> [Text] -> Integer -> Maybe Snowflake -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Role]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"roles"
          Parser ([Emoji] -> [Text] -> Integer -> Maybe Snowflake -> Guild)
-> Parser [Emoji]
-> Parser ([Text] -> Integer -> Maybe Snowflake -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Emoji]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"emojis"
          Parser ([Text] -> Integer -> Maybe Snowflake -> Guild)
-> Parser [Text] -> Parser (Integer -> Maybe Snowflake -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"features"
          Parser (Integer -> Maybe Snowflake -> Guild)
-> Parser Integer -> Parser (Maybe Snowflake -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"mfa_level"
          Parser (Maybe Snowflake -> Guild)
-> Parser (Maybe Snowflake) -> Parser Guild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Snowflake)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"application_id"

data GuildUnavailable = GuildUnavailable
      { GuildUnavailable -> Snowflake
idOnceAvailable :: GuildId
      } deriving (Int -> GuildUnavailable -> ShowS
[GuildUnavailable] -> ShowS
GuildUnavailable -> String
(Int -> GuildUnavailable -> ShowS)
-> (GuildUnavailable -> String)
-> ([GuildUnavailable] -> ShowS)
-> Show GuildUnavailable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildUnavailable] -> ShowS
$cshowList :: [GuildUnavailable] -> ShowS
show :: GuildUnavailable -> String
$cshow :: GuildUnavailable -> String
showsPrec :: Int -> GuildUnavailable -> ShowS
$cshowsPrec :: Int -> GuildUnavailable -> ShowS
Show, GuildUnavailable -> GuildUnavailable -> Bool
(GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> Eq GuildUnavailable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildUnavailable -> GuildUnavailable -> Bool
$c/= :: GuildUnavailable -> GuildUnavailable -> Bool
== :: GuildUnavailable -> GuildUnavailable -> Bool
$c== :: GuildUnavailable -> GuildUnavailable -> Bool
Eq, Eq GuildUnavailable
Eq GuildUnavailable
-> (GuildUnavailable -> GuildUnavailable -> Ordering)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> Bool)
-> (GuildUnavailable -> GuildUnavailable -> GuildUnavailable)
-> (GuildUnavailable -> GuildUnavailable -> GuildUnavailable)
-> Ord GuildUnavailable
GuildUnavailable -> GuildUnavailable -> Bool
GuildUnavailable -> GuildUnavailable -> Ordering
GuildUnavailable -> GuildUnavailable -> GuildUnavailable
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 :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
$cmin :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
max :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
$cmax :: GuildUnavailable -> GuildUnavailable -> GuildUnavailable
>= :: GuildUnavailable -> GuildUnavailable -> Bool
$c>= :: GuildUnavailable -> GuildUnavailable -> Bool
> :: GuildUnavailable -> GuildUnavailable -> Bool
$c> :: GuildUnavailable -> GuildUnavailable -> Bool
<= :: GuildUnavailable -> GuildUnavailable -> Bool
$c<= :: GuildUnavailable -> GuildUnavailable -> Bool
< :: GuildUnavailable -> GuildUnavailable -> Bool
$c< :: GuildUnavailable -> GuildUnavailable -> Bool
compare :: GuildUnavailable -> GuildUnavailable -> Ordering
$ccompare :: GuildUnavailable -> GuildUnavailable -> Ordering
$cp1Ord :: Eq GuildUnavailable
Ord)

instance FromJSON GuildUnavailable where
  parseJSON :: Value -> Parser GuildUnavailable
parseJSON = String
-> (Object -> Parser GuildUnavailable)
-> Value
-> Parser GuildUnavailable
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildUnavailable" ((Object -> Parser GuildUnavailable)
 -> Value -> Parser GuildUnavailable)
-> (Object -> Parser GuildUnavailable)
-> Value
-> Parser GuildUnavailable
forall a b. (a -> b) -> a -> b
$ \Object
o ->
       Snowflake -> GuildUnavailable
GuildUnavailable (Snowflake -> GuildUnavailable)
-> Parser Snowflake -> Parser GuildUnavailable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"

data GuildInfo = GuildInfo
      { GuildInfo -> UTCTime
guildJoinedAt    :: UTCTime
      , GuildInfo -> Bool
guildLarge       :: Bool
      , GuildInfo -> Integer
guildMemberCount :: Integer
   -- , guildVoiceStates :: [VoiceState]  -- (without guildid) todo have to add voice state data type
      , GuildInfo -> [GuildMember]
guildMembers     :: [GuildMember]
      , GuildInfo -> [Channel]
guildChannels    :: [Channel]     -- ^ Channels in the guild (sent in GuildCreate)
   -- , guildPresences   :: [Presence]
      } deriving (Int -> GuildInfo -> ShowS
[GuildInfo] -> ShowS
GuildInfo -> String
(Int -> GuildInfo -> ShowS)
-> (GuildInfo -> String)
-> ([GuildInfo] -> ShowS)
-> Show GuildInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildInfo] -> ShowS
$cshowList :: [GuildInfo] -> ShowS
show :: GuildInfo -> String
$cshow :: GuildInfo -> String
showsPrec :: Int -> GuildInfo -> ShowS
$cshowsPrec :: Int -> GuildInfo -> ShowS
Show, GuildInfo -> GuildInfo -> Bool
(GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool) -> Eq GuildInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildInfo -> GuildInfo -> Bool
$c/= :: GuildInfo -> GuildInfo -> Bool
== :: GuildInfo -> GuildInfo -> Bool
$c== :: GuildInfo -> GuildInfo -> Bool
Eq, Eq GuildInfo
Eq GuildInfo
-> (GuildInfo -> GuildInfo -> Ordering)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> Bool)
-> (GuildInfo -> GuildInfo -> GuildInfo)
-> (GuildInfo -> GuildInfo -> GuildInfo)
-> Ord GuildInfo
GuildInfo -> GuildInfo -> Bool
GuildInfo -> GuildInfo -> Ordering
GuildInfo -> GuildInfo -> GuildInfo
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 :: GuildInfo -> GuildInfo -> GuildInfo
$cmin :: GuildInfo -> GuildInfo -> GuildInfo
max :: GuildInfo -> GuildInfo -> GuildInfo
$cmax :: GuildInfo -> GuildInfo -> GuildInfo
>= :: GuildInfo -> GuildInfo -> Bool
$c>= :: GuildInfo -> GuildInfo -> Bool
> :: GuildInfo -> GuildInfo -> Bool
$c> :: GuildInfo -> GuildInfo -> Bool
<= :: GuildInfo -> GuildInfo -> Bool
$c<= :: GuildInfo -> GuildInfo -> Bool
< :: GuildInfo -> GuildInfo -> Bool
$c< :: GuildInfo -> GuildInfo -> Bool
compare :: GuildInfo -> GuildInfo -> Ordering
$ccompare :: GuildInfo -> GuildInfo -> Ordering
$cp1Ord :: Eq GuildInfo
Ord)

instance FromJSON GuildInfo where
  parseJSON :: Value -> Parser GuildInfo
parseJSON = String -> (Object -> Parser GuildInfo) -> Value -> Parser GuildInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildInfo" ((Object -> Parser GuildInfo) -> Value -> Parser GuildInfo)
-> (Object -> Parser GuildInfo) -> Value -> Parser GuildInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    UTCTime
-> Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo
GuildInfo (UTCTime
 -> Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo)
-> Parser UTCTime
-> Parser
     (Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"joined_at"
              Parser (Bool -> Integer -> [GuildMember] -> [Channel] -> GuildInfo)
-> Parser Bool
-> Parser (Integer -> [GuildMember] -> [Channel] -> GuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"large"
              Parser (Integer -> [GuildMember] -> [Channel] -> GuildInfo)
-> Parser Integer
-> Parser ([GuildMember] -> [Channel] -> GuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"member_count"
           -- <*> o .: "voice_states"
              Parser ([GuildMember] -> [Channel] -> GuildInfo)
-> Parser [GuildMember] -> Parser ([Channel] -> GuildInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [GuildMember]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"members"
              Parser ([Channel] -> GuildInfo)
-> Parser [Channel] -> Parser GuildInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Channel]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channels"

data PartialGuild = PartialGuild
      { PartialGuild -> Snowflake
partialGuildId          :: GuildId
      , PartialGuild -> Text
partialGuildName        :: T.Text
      , PartialGuild -> Maybe Text
partialGuildIcon        :: Maybe T.Text
      , PartialGuild -> Bool
partialGuildOwner       :: Bool
      , PartialGuild -> Integer
partialGuildPermissions :: Integer
      } deriving (Int -> PartialGuild -> ShowS
[PartialGuild] -> ShowS
PartialGuild -> String
(Int -> PartialGuild -> ShowS)
-> (PartialGuild -> String)
-> ([PartialGuild] -> ShowS)
-> Show PartialGuild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialGuild] -> ShowS
$cshowList :: [PartialGuild] -> ShowS
show :: PartialGuild -> String
$cshow :: PartialGuild -> String
showsPrec :: Int -> PartialGuild -> ShowS
$cshowsPrec :: Int -> PartialGuild -> ShowS
Show, PartialGuild -> PartialGuild -> Bool
(PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool) -> Eq PartialGuild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialGuild -> PartialGuild -> Bool
$c/= :: PartialGuild -> PartialGuild -> Bool
== :: PartialGuild -> PartialGuild -> Bool
$c== :: PartialGuild -> PartialGuild -> Bool
Eq, Eq PartialGuild
Eq PartialGuild
-> (PartialGuild -> PartialGuild -> Ordering)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> Bool)
-> (PartialGuild -> PartialGuild -> PartialGuild)
-> (PartialGuild -> PartialGuild -> PartialGuild)
-> Ord PartialGuild
PartialGuild -> PartialGuild -> Bool
PartialGuild -> PartialGuild -> Ordering
PartialGuild -> PartialGuild -> PartialGuild
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 :: PartialGuild -> PartialGuild -> PartialGuild
$cmin :: PartialGuild -> PartialGuild -> PartialGuild
max :: PartialGuild -> PartialGuild -> PartialGuild
$cmax :: PartialGuild -> PartialGuild -> PartialGuild
>= :: PartialGuild -> PartialGuild -> Bool
$c>= :: PartialGuild -> PartialGuild -> Bool
> :: PartialGuild -> PartialGuild -> Bool
$c> :: PartialGuild -> PartialGuild -> Bool
<= :: PartialGuild -> PartialGuild -> Bool
$c<= :: PartialGuild -> PartialGuild -> Bool
< :: PartialGuild -> PartialGuild -> Bool
$c< :: PartialGuild -> PartialGuild -> Bool
compare :: PartialGuild -> PartialGuild -> Ordering
$ccompare :: PartialGuild -> PartialGuild -> Ordering
$cp1Ord :: Eq PartialGuild
Ord)

instance FromJSON PartialGuild where
  parseJSON :: Value -> Parser PartialGuild
parseJSON = String
-> (Object -> Parser PartialGuild) -> Value -> Parser PartialGuild
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialGuild" ((Object -> Parser PartialGuild) -> Value -> Parser PartialGuild)
-> (Object -> Parser PartialGuild) -> Value -> Parser PartialGuild
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Snowflake -> Text -> Maybe Text -> Bool -> Integer -> PartialGuild
PartialGuild (Snowflake
 -> Text -> Maybe Text -> Bool -> Integer -> PartialGuild)
-> Parser Snowflake
-> Parser (Text -> Maybe Text -> Bool -> Integer -> PartialGuild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id"
                 Parser (Text -> Maybe Text -> Bool -> Integer -> PartialGuild)
-> Parser Text
-> Parser (Maybe Text -> Bool -> Integer -> PartialGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name"
                 Parser (Maybe Text -> Bool -> Integer -> PartialGuild)
-> Parser (Maybe Text) -> Parser (Bool -> Integer -> PartialGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"icon"
                 Parser (Bool -> Integer -> PartialGuild)
-> Parser Bool -> Parser (Integer -> PartialGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?  Text
"owner" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                 Parser (Integer -> PartialGuild)
-> Parser Integer -> Parser PartialGuild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"permissions"


-- | Roles represent a set of permissions attached to a group of users. Roles have unique
--   names, colors, and can be "pinned" to the side bar, causing their members to be listed separately.
--   Roles are unique per guild, and can have separate permission profiles for the global context
--   (guild) and channel context.
data Role =
    Role {
        Role -> Snowflake
roleId      :: RoleId -- ^ The role id
      , Role -> Text
roleName    :: T.Text                    -- ^ The role name
      , Role -> Integer
roleColor   :: Integer                   -- ^ Integer representation of color code
      , Role -> Bool
roleHoist   :: Bool                      -- ^ If the role is pinned in the user listing
      , Role -> Integer
rolePos     :: Integer                   -- ^ Position of this role
      , Role -> Integer
rolePerms   :: Integer                   -- ^ Permission bit set
      , Role -> Bool
roleManaged :: Bool                      -- ^ Whether this role is managed by an integration
      , Role -> Bool
roleMention :: Bool                      -- ^ Whether this role is mentionable
    } deriving (Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq, Eq Role
Eq Role
-> (Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
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 :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmax :: Role -> Role -> Role
>= :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c< :: Role -> Role -> Bool
compare :: Role -> Role -> Ordering
$ccompare :: Role -> Role -> Ordering
$cp1Ord :: Eq Role
Ord)

instance FromJSON Role where
  parseJSON :: Value -> Parser Role
parseJSON = String -> (Object -> Parser Role) -> Value -> Parser Role
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Role" ((Object -> Parser Role) -> Value -> Parser Role)
-> (Object -> Parser Role) -> Value -> Parser Role
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Snowflake
-> Text
-> Integer
-> Bool
-> Integer
-> Integer
-> Bool
-> Bool
-> Role
Role (Snowflake
 -> Text
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> Bool
 -> Bool
 -> Role)
-> Parser Snowflake
-> Parser
     (Text
      -> Integer -> Bool -> Integer -> Integer -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
         Parser
  (Text
   -> Integer -> Bool -> Integer -> Integer -> Bool -> Bool -> Role)
-> Parser Text
-> Parser
     (Integer -> Bool -> Integer -> Integer -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
         Parser
  (Integer -> Bool -> Integer -> Integer -> Bool -> Bool -> Role)
-> Parser Integer
-> Parser (Bool -> Integer -> Integer -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"color"
         Parser (Bool -> Integer -> Integer -> Bool -> Bool -> Role)
-> Parser Bool
-> Parser (Integer -> Integer -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"hoist"
         Parser (Integer -> Integer -> Bool -> Bool -> Role)
-> Parser Integer -> Parser (Integer -> Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"position"
         Parser (Integer -> Bool -> Bool -> Role)
-> Parser Integer -> Parser (Bool -> Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"permissions"
         Parser (Bool -> Bool -> Role)
-> Parser Bool -> Parser (Bool -> Role)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"managed"
         Parser (Bool -> Role) -> Parser Bool -> Parser Role
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mentionable"

-- | VoiceRegion is only refrenced in Guild endpoints, will be moved when voice support is added
data VoiceRegion = VoiceRegion
      { VoiceRegion -> Text
voiceRegionId          :: T.Text      -- ^ Unique id of the region
      , VoiceRegion -> Text
voiceRegionName        :: T.Text      -- ^ Name of the region
      , VoiceRegion -> Bool
voiceRegionVip         :: Bool        -- ^ True if this is a VIP only server
      , VoiceRegion -> Bool
voiceRegionOptimal     :: Bool        -- ^ True for the closest server to a client
      , VoiceRegion -> Bool
voiceRegionDeprecated  :: Bool        -- ^ Whether this is a deprecated region
      , VoiceRegion -> Bool
voiceRegionCustom      :: Bool        -- ^ Whether this is a custom region
      } deriving (Int -> VoiceRegion -> ShowS
[VoiceRegion] -> ShowS
VoiceRegion -> String
(Int -> VoiceRegion -> ShowS)
-> (VoiceRegion -> String)
-> ([VoiceRegion] -> ShowS)
-> Show VoiceRegion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VoiceRegion] -> ShowS
$cshowList :: [VoiceRegion] -> ShowS
show :: VoiceRegion -> String
$cshow :: VoiceRegion -> String
showsPrec :: Int -> VoiceRegion -> ShowS
$cshowsPrec :: Int -> VoiceRegion -> ShowS
Show, VoiceRegion -> VoiceRegion -> Bool
(VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool) -> Eq VoiceRegion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VoiceRegion -> VoiceRegion -> Bool
$c/= :: VoiceRegion -> VoiceRegion -> Bool
== :: VoiceRegion -> VoiceRegion -> Bool
$c== :: VoiceRegion -> VoiceRegion -> Bool
Eq, Eq VoiceRegion
Eq VoiceRegion
-> (VoiceRegion -> VoiceRegion -> Ordering)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> Bool)
-> (VoiceRegion -> VoiceRegion -> VoiceRegion)
-> (VoiceRegion -> VoiceRegion -> VoiceRegion)
-> Ord VoiceRegion
VoiceRegion -> VoiceRegion -> Bool
VoiceRegion -> VoiceRegion -> Ordering
VoiceRegion -> VoiceRegion -> VoiceRegion
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 :: VoiceRegion -> VoiceRegion -> VoiceRegion
$cmin :: VoiceRegion -> VoiceRegion -> VoiceRegion
max :: VoiceRegion -> VoiceRegion -> VoiceRegion
$cmax :: VoiceRegion -> VoiceRegion -> VoiceRegion
>= :: VoiceRegion -> VoiceRegion -> Bool
$c>= :: VoiceRegion -> VoiceRegion -> Bool
> :: VoiceRegion -> VoiceRegion -> Bool
$c> :: VoiceRegion -> VoiceRegion -> Bool
<= :: VoiceRegion -> VoiceRegion -> Bool
$c<= :: VoiceRegion -> VoiceRegion -> Bool
< :: VoiceRegion -> VoiceRegion -> Bool
$c< :: VoiceRegion -> VoiceRegion -> Bool
compare :: VoiceRegion -> VoiceRegion -> Ordering
$ccompare :: VoiceRegion -> VoiceRegion -> Ordering
$cp1Ord :: Eq VoiceRegion
Ord)

instance FromJSON VoiceRegion where
  parseJSON :: Value -> Parser VoiceRegion
parseJSON = String
-> (Object -> Parser VoiceRegion) -> Value -> Parser VoiceRegion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"VoiceRegion" ((Object -> Parser VoiceRegion) -> Value -> Parser VoiceRegion)
-> (Object -> Parser VoiceRegion) -> Value -> Parser VoiceRegion
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion
VoiceRegion (Text -> Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Text
-> Parser (Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
                Parser (Text -> Bool -> Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Text
-> Parser (Bool -> Bool -> Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser (Bool -> Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"vip"
                Parser (Bool -> Bool -> Bool -> VoiceRegion)
-> Parser Bool -> Parser (Bool -> Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"optimal"
                Parser (Bool -> Bool -> VoiceRegion)
-> Parser Bool -> Parser (Bool -> VoiceRegion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"deprecated"
                Parser (Bool -> VoiceRegion) -> Parser Bool -> Parser VoiceRegion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"custom"

-- | Info about a Ban
data GuildBan = GuildBan
      { GuildBan -> Text
guildBanReason  :: T.Text
      , GuildBan -> User
guildBanUser    :: User
      } deriving (Int -> GuildBan -> ShowS
[GuildBan] -> ShowS
GuildBan -> String
(Int -> GuildBan -> ShowS)
-> (GuildBan -> String) -> ([GuildBan] -> ShowS) -> Show GuildBan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildBan] -> ShowS
$cshowList :: [GuildBan] -> ShowS
show :: GuildBan -> String
$cshow :: GuildBan -> String
showsPrec :: Int -> GuildBan -> ShowS
$cshowsPrec :: Int -> GuildBan -> ShowS
Show, GuildBan -> GuildBan -> Bool
(GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool) -> Eq GuildBan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildBan -> GuildBan -> Bool
$c/= :: GuildBan -> GuildBan -> Bool
== :: GuildBan -> GuildBan -> Bool
$c== :: GuildBan -> GuildBan -> Bool
Eq, Eq GuildBan
Eq GuildBan
-> (GuildBan -> GuildBan -> Ordering)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> Bool)
-> (GuildBan -> GuildBan -> GuildBan)
-> (GuildBan -> GuildBan -> GuildBan)
-> Ord GuildBan
GuildBan -> GuildBan -> Bool
GuildBan -> GuildBan -> Ordering
GuildBan -> GuildBan -> GuildBan
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 :: GuildBan -> GuildBan -> GuildBan
$cmin :: GuildBan -> GuildBan -> GuildBan
max :: GuildBan -> GuildBan -> GuildBan
$cmax :: GuildBan -> GuildBan -> GuildBan
>= :: GuildBan -> GuildBan -> Bool
$c>= :: GuildBan -> GuildBan -> Bool
> :: GuildBan -> GuildBan -> Bool
$c> :: GuildBan -> GuildBan -> Bool
<= :: GuildBan -> GuildBan -> Bool
$c<= :: GuildBan -> GuildBan -> Bool
< :: GuildBan -> GuildBan -> Bool
$c< :: GuildBan -> GuildBan -> Bool
compare :: GuildBan -> GuildBan -> Ordering
$ccompare :: GuildBan -> GuildBan -> Ordering
$cp1Ord :: Eq GuildBan
Ord)

instance FromJSON GuildBan where
  parseJSON :: Value -> Parser GuildBan
parseJSON = String -> (Object -> Parser GuildBan) -> Value -> Parser GuildBan
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildBan" ((Object -> Parser GuildBan) -> Value -> Parser GuildBan)
-> (Object -> Parser GuildBan) -> Value -> Parser GuildBan
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> User -> GuildBan
GuildBan (Text -> User -> GuildBan)
-> Parser Text -> Parser (User -> GuildBan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reason" Parser (User -> GuildBan) -> Parser User -> Parser GuildBan
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"

-- | Represents a code to add a user to a guild
data Invite = Invite
      { Invite -> Text
inviteCode  :: T.Text    -- ^ The invite code
      , Invite -> Maybe Snowflake
inviteGuildId :: Maybe GuildId -- ^ The guild the code will invite to
      , Invite -> Snowflake
inviteChannelId :: ChannelId -- ^ The channel the code will invite to
      } deriving (Int -> Invite -> ShowS
[Invite] -> ShowS
Invite -> String
(Int -> Invite -> ShowS)
-> (Invite -> String) -> ([Invite] -> ShowS) -> Show Invite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Invite] -> ShowS
$cshowList :: [Invite] -> ShowS
show :: Invite -> String
$cshow :: Invite -> String
showsPrec :: Int -> Invite -> ShowS
$cshowsPrec :: Int -> Invite -> ShowS
Show, Invite -> Invite -> Bool
(Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool) -> Eq Invite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Invite -> Invite -> Bool
$c/= :: Invite -> Invite -> Bool
== :: Invite -> Invite -> Bool
$c== :: Invite -> Invite -> Bool
Eq, Eq Invite
Eq Invite
-> (Invite -> Invite -> Ordering)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Bool)
-> (Invite -> Invite -> Invite)
-> (Invite -> Invite -> Invite)
-> Ord Invite
Invite -> Invite -> Bool
Invite -> Invite -> Ordering
Invite -> Invite -> Invite
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 :: Invite -> Invite -> Invite
$cmin :: Invite -> Invite -> Invite
max :: Invite -> Invite -> Invite
$cmax :: Invite -> Invite -> Invite
>= :: Invite -> Invite -> Bool
$c>= :: Invite -> Invite -> Bool
> :: Invite -> Invite -> Bool
$c> :: Invite -> Invite -> Bool
<= :: Invite -> Invite -> Bool
$c<= :: Invite -> Invite -> Bool
< :: Invite -> Invite -> Bool
$c< :: Invite -> Invite -> Bool
compare :: Invite -> Invite -> Ordering
$ccompare :: Invite -> Invite -> Ordering
$cp1Ord :: Eq Invite
Ord)

instance FromJSON Invite where
  parseJSON :: Value -> Parser Invite
parseJSON = String -> (Object -> Parser Invite) -> Value -> Parser Invite
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Invite" ((Object -> Parser Invite) -> Value -> Parser Invite)
-> (Object -> Parser Invite) -> Value -> Parser Invite
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Snowflake -> Snowflake -> Invite
Invite (Text -> Maybe Snowflake -> Snowflake -> Invite)
-> Parser Text -> Parser (Maybe Snowflake -> Snowflake -> Invite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"code"
           Parser (Maybe Snowflake -> Snowflake -> Invite)
-> Parser (Maybe Snowflake) -> Parser (Snowflake -> Invite)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (do Maybe Object
g <- Object
o Object -> Text -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"guild"
                   case Maybe Object
g of Just Object
g2 -> Object
g2 Object -> Text -> Parser (Maybe Snowflake)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
                             Maybe Object
Nothing -> Maybe Snowflake -> Parser (Maybe Snowflake)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Snowflake
forall a. Maybe a
Nothing)
           Parser (Snowflake -> Invite) -> Parser Snowflake -> Parser Invite
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channel") Parser Object -> (Object -> Parser Snowflake) -> Parser Snowflake
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"))

-- | Invite code with additional metadata
data InviteWithMeta = InviteWithMeta Invite InviteMeta

instance FromJSON InviteWithMeta where
  parseJSON :: Value -> Parser InviteWithMeta
parseJSON Value
ob = Invite -> InviteMeta -> InviteWithMeta
InviteWithMeta (Invite -> InviteMeta -> InviteWithMeta)
-> Parser Invite -> Parser (InviteMeta -> InviteWithMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Invite
forall a. FromJSON a => Value -> Parser a
parseJSON Value
ob Parser (InviteMeta -> InviteWithMeta)
-> Parser InviteMeta -> Parser InviteWithMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser InviteMeta
forall a. FromJSON a => Value -> Parser a
parseJSON Value
ob

-- | Additional metadata about an invite.
data InviteMeta = InviteMeta
    { InviteMeta -> User
inviteCreator :: User    -- ^ The user that created the invite
    , InviteMeta -> Integer
inviteUses    :: Integer -- ^ Number of times the invite has been used
    , InviteMeta -> Integer
inviteMax     :: Integer -- ^ Max number of times the invite can be used
    , InviteMeta -> Integer
inviteAge     :: Integer -- ^ The duration (in seconds) after which the invite expires
    , InviteMeta -> Bool
inviteTemp    :: Bool    -- ^ Whether this invite only grants temporary membership
    , InviteMeta -> UTCTime
inviteCreated :: UTCTime -- ^ When the invite was created
    , InviteMeta -> Bool
inviteRevoked :: Bool    -- ^ If the invite is revoked
    } deriving (Int -> InviteMeta -> ShowS
[InviteMeta] -> ShowS
InviteMeta -> String
(Int -> InviteMeta -> ShowS)
-> (InviteMeta -> String)
-> ([InviteMeta] -> ShowS)
-> Show InviteMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InviteMeta] -> ShowS
$cshowList :: [InviteMeta] -> ShowS
show :: InviteMeta -> String
$cshow :: InviteMeta -> String
showsPrec :: Int -> InviteMeta -> ShowS
$cshowsPrec :: Int -> InviteMeta -> ShowS
Show, InviteMeta -> InviteMeta -> Bool
(InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool) -> Eq InviteMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InviteMeta -> InviteMeta -> Bool
$c/= :: InviteMeta -> InviteMeta -> Bool
== :: InviteMeta -> InviteMeta -> Bool
$c== :: InviteMeta -> InviteMeta -> Bool
Eq, Eq InviteMeta
Eq InviteMeta
-> (InviteMeta -> InviteMeta -> Ordering)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> Bool)
-> (InviteMeta -> InviteMeta -> InviteMeta)
-> (InviteMeta -> InviteMeta -> InviteMeta)
-> Ord InviteMeta
InviteMeta -> InviteMeta -> Bool
InviteMeta -> InviteMeta -> Ordering
InviteMeta -> InviteMeta -> InviteMeta
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 :: InviteMeta -> InviteMeta -> InviteMeta
$cmin :: InviteMeta -> InviteMeta -> InviteMeta
max :: InviteMeta -> InviteMeta -> InviteMeta
$cmax :: InviteMeta -> InviteMeta -> InviteMeta
>= :: InviteMeta -> InviteMeta -> Bool
$c>= :: InviteMeta -> InviteMeta -> Bool
> :: InviteMeta -> InviteMeta -> Bool
$c> :: InviteMeta -> InviteMeta -> Bool
<= :: InviteMeta -> InviteMeta -> Bool
$c<= :: InviteMeta -> InviteMeta -> Bool
< :: InviteMeta -> InviteMeta -> Bool
$c< :: InviteMeta -> InviteMeta -> Bool
compare :: InviteMeta -> InviteMeta -> Ordering
$ccompare :: InviteMeta -> InviteMeta -> Ordering
$cp1Ord :: Eq InviteMeta
Ord)

instance FromJSON InviteMeta where
  parseJSON :: Value -> Parser InviteMeta
parseJSON = String
-> (Object -> Parser InviteMeta) -> Value -> Parser InviteMeta
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InviteMeta" ((Object -> Parser InviteMeta) -> Value -> Parser InviteMeta)
-> (Object -> Parser InviteMeta) -> Value -> Parser InviteMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    User
-> Integer
-> Integer
-> Integer
-> Bool
-> UTCTime
-> Bool
-> InviteMeta
InviteMeta (User
 -> Integer
 -> Integer
 -> Integer
 -> Bool
 -> UTCTime
 -> Bool
 -> InviteMeta)
-> Parser User
-> Parser
     (Integer
      -> Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"inviter"
               Parser
  (Integer
   -> Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Integer
-> Parser
     (Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uses"
               Parser
  (Integer -> Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Integer
-> Parser (Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"max_uses"
               Parser (Integer -> Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Integer -> Parser (Bool -> UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"max_age"
               Parser (Bool -> UTCTime -> Bool -> InviteMeta)
-> Parser Bool -> Parser (UTCTime -> Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"temporary"
               Parser (UTCTime -> Bool -> InviteMeta)
-> Parser UTCTime -> Parser (Bool -> InviteMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at"
               Parser (Bool -> InviteMeta) -> Parser Bool -> Parser InviteMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"revoked"

-- | Represents the behavior of a third party account link.
data Integration = Integration
      { Integration -> Snowflake
integrationId       :: !Snowflake -- ^ Integration id
      , Integration -> Text
integrationName     :: T.Text                    -- ^ Integration name
      , Integration -> Text
integrationType     :: T.Text                    -- ^ Integration type (Twitch, Youtube, ect.)
      , Integration -> Bool
integrationEnabled  :: Bool                      -- ^ Is the integration enabled
      , Integration -> Bool
integrationSyncing  :: Bool                      -- ^ Is the integration syncing
      , Integration -> Snowflake
integrationRole     :: RoleId                 -- ^ Id the integration uses for "subscribers"
      , Integration -> Integer
integrationBehavior :: Integer                   -- ^ The behavior of expiring subscribers
      , Integration -> Integer
integrationGrace    :: Integer                   -- ^ The grace period before expiring subscribers
      , Integration -> User
integrationOwner    :: User                      -- ^ The user of the integration
      , Integration -> IntegrationAccount
integrationAccount  :: IntegrationAccount        -- ^ The account the integration links to
      , Integration -> UTCTime
integrationSync     :: UTCTime                   -- ^ When the integration was last synced
      } deriving (Int -> Integration -> ShowS
[Integration] -> ShowS
Integration -> String
(Int -> Integration -> ShowS)
-> (Integration -> String)
-> ([Integration] -> ShowS)
-> Show Integration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Integration] -> ShowS
$cshowList :: [Integration] -> ShowS
show :: Integration -> String
$cshow :: Integration -> String
showsPrec :: Int -> Integration -> ShowS
$cshowsPrec :: Int -> Integration -> ShowS
Show, Integration -> Integration -> Bool
(Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool) -> Eq Integration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Integration -> Integration -> Bool
$c/= :: Integration -> Integration -> Bool
== :: Integration -> Integration -> Bool
$c== :: Integration -> Integration -> Bool
Eq, Eq Integration
Eq Integration
-> (Integration -> Integration -> Ordering)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Bool)
-> (Integration -> Integration -> Integration)
-> (Integration -> Integration -> Integration)
-> Ord Integration
Integration -> Integration -> Bool
Integration -> Integration -> Ordering
Integration -> Integration -> Integration
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 :: Integration -> Integration -> Integration
$cmin :: Integration -> Integration -> Integration
max :: Integration -> Integration -> Integration
$cmax :: Integration -> Integration -> Integration
>= :: Integration -> Integration -> Bool
$c>= :: Integration -> Integration -> Bool
> :: Integration -> Integration -> Bool
$c> :: Integration -> Integration -> Bool
<= :: Integration -> Integration -> Bool
$c<= :: Integration -> Integration -> Bool
< :: Integration -> Integration -> Bool
$c< :: Integration -> Integration -> Bool
compare :: Integration -> Integration -> Ordering
$ccompare :: Integration -> Integration -> Ordering
$cp1Ord :: Eq Integration
Ord)

instance FromJSON Integration where
  parseJSON :: Value -> Parser Integration
parseJSON = String
-> (Object -> Parser Integration) -> Value -> Parser Integration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Integration" ((Object -> Parser Integration) -> Value -> Parser Integration)
-> (Object -> Parser Integration) -> Value -> Parser Integration
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Snowflake
-> Text
-> Text
-> Bool
-> Bool
-> Snowflake
-> Integer
-> Integer
-> User
-> IntegrationAccount
-> UTCTime
-> Integration
Integration (Snowflake
 -> Text
 -> Text
 -> Bool
 -> Bool
 -> Snowflake
 -> Integer
 -> Integer
 -> User
 -> IntegrationAccount
 -> UTCTime
 -> Integration)
-> Parser Snowflake
-> Parser
     (Text
      -> Text
      -> Bool
      -> Bool
      -> Snowflake
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
                Parser
  (Text
   -> Text
   -> Bool
   -> Bool
   -> Snowflake
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Bool
      -> Snowflake
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
                Parser
  (Text
   -> Bool
   -> Bool
   -> Snowflake
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Text
-> Parser
     (Bool
      -> Bool
      -> Snowflake
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
                Parser
  (Bool
   -> Bool
   -> Snowflake
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Bool
-> Parser
     (Bool
      -> Snowflake
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"enabled"
                Parser
  (Bool
   -> Snowflake
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Bool
-> Parser
     (Snowflake
      -> Integer
      -> Integer
      -> User
      -> IntegrationAccount
      -> UTCTime
      -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"syncing"
                Parser
  (Snowflake
   -> Integer
   -> Integer
   -> User
   -> IntegrationAccount
   -> UTCTime
   -> Integration)
-> Parser Snowflake
-> Parser
     (Integer
      -> Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"role_id"
                Parser
  (Integer
   -> Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
-> Parser Integer
-> Parser
     (Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expire_behavior"
                Parser
  (Integer -> User -> IntegrationAccount -> UTCTime -> Integration)
-> Parser Integer
-> Parser (User -> IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expire_grace_period"
                Parser (User -> IntegrationAccount -> UTCTime -> Integration)
-> Parser User
-> Parser (IntegrationAccount -> UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
                Parser (IntegrationAccount -> UTCTime -> Integration)
-> Parser IntegrationAccount -> Parser (UTCTime -> Integration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser IntegrationAccount
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"account"
                Parser (UTCTime -> Integration)
-> Parser UTCTime -> Parser Integration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"synced_at"

-- | Represents a third party account link.
data IntegrationAccount = IntegrationAccount
    { IntegrationAccount -> Text
accountId   :: T.Text -- ^ The id of the account.
    , IntegrationAccount -> Text
accountName :: T.Text -- ^ The name of the account.
    } deriving (Int -> IntegrationAccount -> ShowS
[IntegrationAccount] -> ShowS
IntegrationAccount -> String
(Int -> IntegrationAccount -> ShowS)
-> (IntegrationAccount -> String)
-> ([IntegrationAccount] -> ShowS)
-> Show IntegrationAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntegrationAccount] -> ShowS
$cshowList :: [IntegrationAccount] -> ShowS
show :: IntegrationAccount -> String
$cshow :: IntegrationAccount -> String
showsPrec :: Int -> IntegrationAccount -> ShowS
$cshowsPrec :: Int -> IntegrationAccount -> ShowS
Show, IntegrationAccount -> IntegrationAccount -> Bool
(IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> Eq IntegrationAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntegrationAccount -> IntegrationAccount -> Bool
$c/= :: IntegrationAccount -> IntegrationAccount -> Bool
== :: IntegrationAccount -> IntegrationAccount -> Bool
$c== :: IntegrationAccount -> IntegrationAccount -> Bool
Eq, Eq IntegrationAccount
Eq IntegrationAccount
-> (IntegrationAccount -> IntegrationAccount -> Ordering)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> Bool)
-> (IntegrationAccount -> IntegrationAccount -> IntegrationAccount)
-> (IntegrationAccount -> IntegrationAccount -> IntegrationAccount)
-> Ord IntegrationAccount
IntegrationAccount -> IntegrationAccount -> Bool
IntegrationAccount -> IntegrationAccount -> Ordering
IntegrationAccount -> IntegrationAccount -> IntegrationAccount
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 :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
$cmin :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
max :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
$cmax :: IntegrationAccount -> IntegrationAccount -> IntegrationAccount
>= :: IntegrationAccount -> IntegrationAccount -> Bool
$c>= :: IntegrationAccount -> IntegrationAccount -> Bool
> :: IntegrationAccount -> IntegrationAccount -> Bool
$c> :: IntegrationAccount -> IntegrationAccount -> Bool
<= :: IntegrationAccount -> IntegrationAccount -> Bool
$c<= :: IntegrationAccount -> IntegrationAccount -> Bool
< :: IntegrationAccount -> IntegrationAccount -> Bool
$c< :: IntegrationAccount -> IntegrationAccount -> Bool
compare :: IntegrationAccount -> IntegrationAccount -> Ordering
$ccompare :: IntegrationAccount -> IntegrationAccount -> Ordering
$cp1Ord :: Eq IntegrationAccount
Ord)

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

-- | Represents an image to be used in third party sites to link to a discord channel
data GuildEmbed = GuildEmbed
      { GuildEmbed -> Bool
embedEnabled :: Bool      -- ^ Whether the embed is enabled
      , GuildEmbed -> Snowflake
embedChannel :: ChannelId -- ^ The embed channel id
      } deriving (Int -> GuildEmbed -> ShowS
[GuildEmbed] -> ShowS
GuildEmbed -> String
(Int -> GuildEmbed -> ShowS)
-> (GuildEmbed -> String)
-> ([GuildEmbed] -> ShowS)
-> Show GuildEmbed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildEmbed] -> ShowS
$cshowList :: [GuildEmbed] -> ShowS
show :: GuildEmbed -> String
$cshow :: GuildEmbed -> String
showsPrec :: Int -> GuildEmbed -> ShowS
$cshowsPrec :: Int -> GuildEmbed -> ShowS
Show, GuildEmbed -> GuildEmbed -> Bool
(GuildEmbed -> GuildEmbed -> Bool)
-> (GuildEmbed -> GuildEmbed -> Bool) -> Eq GuildEmbed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildEmbed -> GuildEmbed -> Bool
$c/= :: GuildEmbed -> GuildEmbed -> Bool
== :: GuildEmbed -> GuildEmbed -> Bool
$c== :: GuildEmbed -> GuildEmbed -> Bool
Eq, Eq GuildEmbed
Eq GuildEmbed
-> (GuildEmbed -> GuildEmbed -> Ordering)
-> (GuildEmbed -> GuildEmbed -> Bool)
-> (GuildEmbed -> GuildEmbed -> Bool)
-> (GuildEmbed -> GuildEmbed -> Bool)
-> (GuildEmbed -> GuildEmbed -> Bool)
-> (GuildEmbed -> GuildEmbed -> GuildEmbed)
-> (GuildEmbed -> GuildEmbed -> GuildEmbed)
-> Ord GuildEmbed
GuildEmbed -> GuildEmbed -> Bool
GuildEmbed -> GuildEmbed -> Ordering
GuildEmbed -> GuildEmbed -> GuildEmbed
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 :: GuildEmbed -> GuildEmbed -> GuildEmbed
$cmin :: GuildEmbed -> GuildEmbed -> GuildEmbed
max :: GuildEmbed -> GuildEmbed -> GuildEmbed
$cmax :: GuildEmbed -> GuildEmbed -> GuildEmbed
>= :: GuildEmbed -> GuildEmbed -> Bool
$c>= :: GuildEmbed -> GuildEmbed -> Bool
> :: GuildEmbed -> GuildEmbed -> Bool
$c> :: GuildEmbed -> GuildEmbed -> Bool
<= :: GuildEmbed -> GuildEmbed -> Bool
$c<= :: GuildEmbed -> GuildEmbed -> Bool
< :: GuildEmbed -> GuildEmbed -> Bool
$c< :: GuildEmbed -> GuildEmbed -> Bool
compare :: GuildEmbed -> GuildEmbed -> Ordering
$ccompare :: GuildEmbed -> GuildEmbed -> Ordering
$cp1Ord :: Eq GuildEmbed
Ord)

instance FromJSON GuildEmbed where
  parseJSON :: Value -> Parser GuildEmbed
parseJSON = String
-> (Object -> Parser GuildEmbed) -> Value -> Parser GuildEmbed
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GuildEmbed" ((Object -> Parser GuildEmbed) -> Value -> Parser GuildEmbed)
-> (Object -> Parser GuildEmbed) -> Value -> Parser GuildEmbed
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool -> Snowflake -> GuildEmbed
GuildEmbed (Bool -> Snowflake -> GuildEmbed)
-> Parser Bool -> Parser (Snowflake -> GuildEmbed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"enabled" Parser (Snowflake -> GuildEmbed)
-> Parser Snowflake -> Parser GuildEmbed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Snowflake
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"snowflake"

instance ToJSON GuildEmbed where
  toJSON :: GuildEmbed -> Value
toJSON (GuildEmbed Bool
enabled Snowflake
snowflake) = [Pair] -> Value
object
    [ Text
"enabled"   Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
enabled
    , Text
"snowflake" Text -> Snowflake -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Snowflake
snowflake
    ]