-- | Discord Guilds
module Calamity.Types.Model.Guild.Guild (
  Guild (..),
  Partial (PartialGuild),
  UpdatedGuild (..),
) where

import Calamity.Internal.AesonThings
import Calamity.Internal.SnowflakeMap (SnowflakeMap)
import qualified Calamity.Internal.SnowflakeMap as SM
import Calamity.Internal.Utils ()
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild.Emoji
import {-# SOURCE #-} Calamity.Types.Model.Guild.Member
import Calamity.Types.Model.Guild.Role
import Calamity.Types.Model.Presence.Presence
import Calamity.Types.Model.User
import Calamity.Types.Model.Voice.VoiceState
import Calamity.Types.Snowflake
import Control.DeepSeq
import Control.Lens ((^.))
import Data.Aeson
import Data.Generics.Product.Fields
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as LH
import Data.Text.Lazy (Text)
import Data.Time
import Data.Word
import GHC.Generics
import TextShow
import qualified TextShow.Generic as TSG

data Guild = Guild
  { Guild -> Snowflake Guild
id :: Snowflake Guild
  , Guild -> Text
name :: Text
  , Guild -> Maybe Text
icon :: Maybe Text
  , Guild -> Maybe Text
splash :: Maybe Text
  , Guild -> Maybe Bool
owner :: Maybe Bool
  , Guild -> Snowflake User
ownerID :: Snowflake User
  , Guild -> Word64
permissions :: Word64
  , Guild -> Text
region :: Text
  , Guild -> Maybe (Snowflake GuildChannel)
afkChannelID :: Maybe (Snowflake GuildChannel)
  , Guild -> Int
afkTimeout :: Int
  , Guild -> Bool
embedEnabled :: Bool
  , Guild -> Maybe (Snowflake GuildChannel)
embedChannelID :: Maybe (Snowflake GuildChannel)
  , Guild -> Int
verificationLevel :: Int
  , Guild -> Int
defaultMessageNotifications :: Int
  , Guild -> Int
explicitContentFilter :: Int
  , Guild -> SnowflakeMap Role
roles :: SnowflakeMap Role
  , Guild -> SnowflakeMap Emoji
emojis :: SnowflakeMap Emoji
  , Guild -> [Text]
features :: [Text]
  , Guild -> Int
mfaLevel :: Int
  , Guild -> Maybe (Snowflake User)
applicationID :: Maybe (Snowflake User)
  , Guild -> Bool
widgetEnabled :: Bool
  , Guild -> Maybe (Snowflake GuildChannel)
widgetChannelID :: Maybe (Snowflake GuildChannel)
  , Guild -> Maybe (Snowflake GuildChannel)
systemChannelID :: Maybe (Snowflake GuildChannel)
  , -- NOTE: Below are only sent on GuildCreate
    Guild -> Maybe UTCTime
joinedAt :: Maybe UTCTime
  , Guild -> Bool
large :: Bool
  , Guild -> Bool
unavailable :: Bool
  , Guild -> Int
memberCount :: Int
  , Guild -> [VoiceState]
voiceStates :: [VoiceState]
  , Guild -> SnowflakeMap Member
members :: SnowflakeMap Member
  , Guild -> SnowflakeMap GuildChannel
channels :: SnowflakeMap GuildChannel
  , Guild -> HashMap (Snowflake User) Presence
presences :: HashMap (Snowflake User) Presence
  }
  deriving (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, 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, (forall x. Guild -> Rep Guild x)
-> (forall x. Rep Guild x -> Guild) -> Generic Guild
forall x. Rep Guild x -> Guild
forall x. Guild -> Rep Guild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Guild x -> Guild
$cfrom :: forall x. Guild -> Rep Guild x
Generic, Guild -> ()
(Guild -> ()) -> NFData Guild
forall a. (a -> ()) -> NFData a
rnf :: Guild -> ()
$crnf :: Guild -> ()
NFData)
  deriving (Int -> Guild -> Builder
Int -> Guild -> Text
Int -> Guild -> Text
[Guild] -> Builder
[Guild] -> Text
[Guild] -> Text
Guild -> Builder
Guild -> Text
Guild -> Text
(Int -> Guild -> Builder)
-> (Guild -> Builder)
-> ([Guild] -> Builder)
-> (Int -> Guild -> Text)
-> (Guild -> Text)
-> ([Guild] -> Text)
-> (Int -> Guild -> Text)
-> (Guild -> Text)
-> ([Guild] -> Text)
-> TextShow Guild
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [Guild] -> Text
$cshowtlList :: [Guild] -> Text
showtl :: Guild -> Text
$cshowtl :: Guild -> Text
showtlPrec :: Int -> Guild -> Text
$cshowtlPrec :: Int -> Guild -> Text
showtList :: [Guild] -> Text
$cshowtList :: [Guild] -> Text
showt :: Guild -> Text
$cshowt :: Guild -> Text
showtPrec :: Int -> Guild -> Text
$cshowtPrec :: Int -> Guild -> Text
showbList :: [Guild] -> Builder
$cshowbList :: [Guild] -> Builder
showb :: Guild -> Builder
$cshowb :: Guild -> Builder
showbPrec :: Int -> Guild -> Builder
$cshowbPrec :: Int -> Guild -> Builder
TextShow) via TSG.FromGeneric Guild
  deriving (HasID Guild) via HasIDField "id" Guild

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
v -> do
    Snowflake Guild
id <- Object
v Object -> Text -> Parser (Snowflake Guild)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"

    SnowflakeMap Member
members' <- do
      [Object]
members' <- Object
v Object -> Text -> Parser [Object]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"members"
      [Member] -> SnowflakeMap Member
forall a. HasID' a => [a] -> SnowflakeMap a
SM.fromList ([Member] -> SnowflakeMap Member)
-> Parser [Member] -> Parser (SnowflakeMap Member)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser Member) -> [Object] -> Parser [Member]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Object
m -> Value -> Parser Member
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Member) -> Value -> Parser Member
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
m Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Text
"guild_id" Text -> Snowflake Guild -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Snowflake Guild
id)) [Object]
members'

    SnowflakeMap GuildChannel
channels' <- do
      [Object]
channels' <- Object
v Object -> Text -> Parser [Object]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channels"
      [GuildChannel] -> SnowflakeMap GuildChannel
forall a. HasID' a => [a] -> SnowflakeMap a
SM.fromList ([GuildChannel] -> SnowflakeMap GuildChannel)
-> Parser [GuildChannel] -> Parser (SnowflakeMap GuildChannel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser GuildChannel)
-> [Object] -> Parser [GuildChannel]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Object
m -> Value -> Parser GuildChannel
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser GuildChannel) -> Value -> Parser GuildChannel
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
m Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Text
"guild_id" Text -> Snowflake Guild -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Snowflake Guild
id)) [Object]
channels'

    HashMap (Snowflake User) Presence
presences' <- do
      [Object]
presences' <- Object
v Object -> Text -> Parser [Object]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"presences"
      [(Snowflake User, Presence)] -> HashMap (Snowflake User) Presence
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList
        ([(Snowflake User, Presence)] -> HashMap (Snowflake User) Presence)
-> Parser [(Snowflake User, Presence)]
-> Parser (HashMap (Snowflake User) Presence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Parser (Snowflake User, Presence))
-> [Object] -> Parser [(Snowflake User, Presence)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
          ( \Object
m -> do
              Presence
p <- Value -> Parser Presence
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Presence) -> Value -> Parser Presence
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
m Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Text
"guild_id" Text -> Snowflake Guild -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Snowflake Guild
id)
              (Snowflake User, Presence) -> Parser (Snowflake User, Presence)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake User -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID (Snowflake User -> Snowflake User)
-> Snowflake User -> Snowflake User
forall a b. (a -> b) -> a -> b
$ Presence
p Presence
-> Getting (Snowflake User) Presence (Snowflake User)
-> Snowflake User
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "user" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"user", Presence
p)
          )
          [Object]
presences'

    Snowflake Guild
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Snowflake User
-> Word64
-> Text
-> Maybe (Snowflake GuildChannel)
-> Int
-> Bool
-> Maybe (Snowflake GuildChannel)
-> Int
-> Int
-> Int
-> SnowflakeMap Role
-> SnowflakeMap Emoji
-> [Text]
-> Int
-> Maybe (Snowflake User)
-> Bool
-> Maybe (Snowflake GuildChannel)
-> Maybe (Snowflake GuildChannel)
-> Maybe UTCTime
-> Bool
-> Bool
-> Int
-> [VoiceState]
-> SnowflakeMap Member
-> SnowflakeMap GuildChannel
-> HashMap (Snowflake User) Presence
-> Guild
Guild Snowflake Guild
id
      (Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Snowflake User
 -> Word64
 -> Text
 -> Maybe (Snowflake GuildChannel)
 -> Int
 -> Bool
 -> Maybe (Snowflake GuildChannel)
 -> Int
 -> Int
 -> Int
 -> SnowflakeMap Role
 -> SnowflakeMap Emoji
 -> [Text]
 -> Int
 -> Maybe (Snowflake User)
 -> Bool
 -> Maybe (Snowflake GuildChannel)
 -> Maybe (Snowflake GuildChannel)
 -> Maybe UTCTime
 -> Bool
 -> Bool
 -> Int
 -> [VoiceState]
 -> SnowflakeMap Member
 -> SnowflakeMap GuildChannel
 -> HashMap (Snowflake User) Presence
 -> Guild)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Word64
      -> Text
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Word64
   -> Text
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Word64
      -> Text
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"icon"
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Word64
   -> Text
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Snowflake User
      -> Word64
      -> Text
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"splash"
      Parser
  (Maybe Bool
   -> Snowflake User
   -> Word64
   -> Text
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Snowflake User
      -> Word64
      -> Text
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"owner"
      Parser
  (Snowflake User
   -> Word64
   -> Text
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Snowflake User)
-> Parser
     (Word64
      -> Text
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Snowflake User)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"owner_id"
      Parser
  (Word64
   -> Text
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Word64
-> Parser
     (Text
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"permissions" Parser (Maybe Word64) -> Word64 -> Parser Word64
forall a. Parser (Maybe a) -> a -> Parser a
.!= Word64
0
      Parser
  (Text
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Text
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"region"
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Int
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"afk_channel_id"
      Parser
  (Int
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Int
-> Parser
     (Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"afk_timeout"
      Parser
  (Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Bool
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"embed_enabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"embed_channel_id"
      Parser
  (Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"verification_level"
      Parser
  (Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Int
-> Parser
     (Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"default_message_notifications"
      Parser
  (Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Int
-> Parser
     (SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"explicit_content_filter"
      Parser
  (SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (SnowflakeMap Role)
-> Parser
     (SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (SnowflakeMap Role)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"roles"
      Parser
  (SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (SnowflakeMap Emoji)
-> Parser
     ([Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (SnowflakeMap Emoji)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"emojis"
      Parser
  ([Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser [Text]
-> Parser
     (Int
      -> Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"features"
      Parser
  (Int
   -> Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Int
-> Parser
     (Maybe (Snowflake User)
      -> Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mfa_level"
      Parser
  (Maybe (Snowflake User)
   -> Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe (Snowflake User))
-> Parser
     (Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Snowflake User))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"application_id"
      Parser
  (Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Bool
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"widget_enabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"widget_channel_id"
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"system_channel_id"
      Parser
  (Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (Maybe UTCTime)
-> Parser
     (Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"joined_at"
      Parser
  (Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Bool
-> Parser
     (Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"large"
      Parser
  (Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Bool
-> Parser
     (Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"unavailable"
      Parser
  (Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser Int
-> Parser
     ([VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"member_count"
      Parser
  ([VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser [VoiceState]
-> Parser
     (SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [VoiceState]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"voice_states"
      Parser
  (SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Guild)
-> Parser (SnowflakeMap Member)
-> Parser
     (SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnowflakeMap Member -> Parser (SnowflakeMap Member)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnowflakeMap Member
members'
      Parser
  (SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence -> Guild)
-> Parser (SnowflakeMap GuildChannel)
-> Parser (HashMap (Snowflake User) Presence -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SnowflakeMap GuildChannel -> Parser (SnowflakeMap GuildChannel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnowflakeMap GuildChannel
channels'
      Parser (HashMap (Snowflake User) Presence -> Guild)
-> Parser (HashMap (Snowflake User) Presence) -> Parser Guild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap (Snowflake User) Presence
-> Parser (HashMap (Snowflake User) Presence)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap (Snowflake User) Presence
presences'

data instance Partial Guild = PartialGuild
  { Partial Guild -> Snowflake Guild
id :: Snowflake Guild
  , Partial Guild -> Text
name :: Text
  }
  deriving (Partial Guild -> Partial Guild -> Bool
(Partial Guild -> Partial Guild -> Bool)
-> (Partial Guild -> Partial Guild -> Bool) -> Eq (Partial Guild)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Partial Guild -> Partial Guild -> Bool
$c/= :: Partial Guild -> Partial Guild -> Bool
== :: Partial Guild -> Partial Guild -> Bool
$c== :: Partial Guild -> Partial Guild -> Bool
Eq, Int -> Partial Guild -> ShowS
[Partial Guild] -> ShowS
Partial Guild -> String
(Int -> Partial Guild -> ShowS)
-> (Partial Guild -> String)
-> ([Partial Guild] -> ShowS)
-> Show (Partial Guild)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Partial Guild] -> ShowS
$cshowList :: [Partial Guild] -> ShowS
show :: Partial Guild -> String
$cshow :: Partial Guild -> String
showsPrec :: Int -> Partial Guild -> ShowS
$cshowsPrec :: Int -> Partial Guild -> ShowS
Show, (forall x. Partial Guild -> Rep (Partial Guild) x)
-> (forall x. Rep (Partial Guild) x -> Partial Guild)
-> Generic (Partial Guild)
forall x. Rep (Partial Guild) x -> Partial Guild
forall x. Partial Guild -> Rep (Partial Guild) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Partial Guild) x -> Partial Guild
$cfrom :: forall x. Partial Guild -> Rep (Partial Guild) x
Generic)
  deriving (Int -> Partial Guild -> Builder
Int -> Partial Guild -> Text
Int -> Partial Guild -> Text
[Partial Guild] -> Builder
[Partial Guild] -> Text
[Partial Guild] -> Text
Partial Guild -> Builder
Partial Guild -> Text
Partial Guild -> Text
(Int -> Partial Guild -> Builder)
-> (Partial Guild -> Builder)
-> ([Partial Guild] -> Builder)
-> (Int -> Partial Guild -> Text)
-> (Partial Guild -> Text)
-> ([Partial Guild] -> Text)
-> (Int -> Partial Guild -> Text)
-> (Partial Guild -> Text)
-> ([Partial Guild] -> Text)
-> TextShow (Partial Guild)
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [Partial Guild] -> Text
$cshowtlList :: [Partial Guild] -> Text
showtl :: Partial Guild -> Text
$cshowtl :: Partial Guild -> Text
showtlPrec :: Int -> Partial Guild -> Text
$cshowtlPrec :: Int -> Partial Guild -> Text
showtList :: [Partial Guild] -> Text
$cshowtList :: [Partial Guild] -> Text
showt :: Partial Guild -> Text
$cshowt :: Partial Guild -> Text
showtPrec :: Int -> Partial Guild -> Text
$cshowtPrec :: Int -> Partial Guild -> Text
showbList :: [Partial Guild] -> Builder
$cshowbList :: [Partial Guild] -> Builder
showb :: Partial Guild -> Builder
$cshowb :: Partial Guild -> Builder
showbPrec :: Int -> Partial Guild -> Builder
$cshowbPrec :: Int -> Partial Guild -> Builder
TextShow) via TSG.FromGeneric (Partial Guild)
  deriving ([Partial Guild] -> Encoding
[Partial Guild] -> Value
Partial Guild -> Encoding
Partial Guild -> Value
(Partial Guild -> Value)
-> (Partial Guild -> Encoding)
-> ([Partial Guild] -> Value)
-> ([Partial Guild] -> Encoding)
-> ToJSON (Partial Guild)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Partial Guild] -> Encoding
$ctoEncodingList :: [Partial Guild] -> Encoding
toJSONList :: [Partial Guild] -> Value
$ctoJSONList :: [Partial Guild] -> Value
toEncoding :: Partial Guild -> Encoding
$ctoEncoding :: Partial Guild -> Encoding
toJSON :: Partial Guild -> Value
$ctoJSON :: Partial Guild -> Value
ToJSON, Value -> Parser [Partial Guild]
Value -> Parser (Partial Guild)
(Value -> Parser (Partial Guild))
-> (Value -> Parser [Partial Guild]) -> FromJSON (Partial Guild)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Partial Guild]
$cparseJSONList :: Value -> Parser [Partial Guild]
parseJSON :: Value -> Parser (Partial Guild)
$cparseJSON :: Value -> Parser (Partial Guild)
FromJSON) via CalamityJSON (Partial Guild)
  deriving (HasID Guild) via HasIDField "id" (Partial Guild)

data UpdatedGuild = UpdatedGuild
  { UpdatedGuild -> Snowflake Guild
id :: Snowflake Guild
  , UpdatedGuild -> Text
name :: Text
  , UpdatedGuild -> Maybe Text
icon :: Maybe Text
  , UpdatedGuild -> Maybe Text
splash :: Maybe Text
  , UpdatedGuild -> Maybe Bool
owner :: Maybe Bool
  , UpdatedGuild -> Snowflake User
ownerID :: Snowflake User
  , UpdatedGuild -> Maybe Word64
permissions :: Maybe Word64
  , UpdatedGuild -> Text
region :: Text
  , UpdatedGuild -> Maybe (Snowflake GuildChannel)
afkChannelID :: Maybe (Snowflake GuildChannel)
  , UpdatedGuild -> Int
afkTimeout :: Int
  , UpdatedGuild -> Maybe Bool
embedEnabled :: Maybe Bool
  , UpdatedGuild -> Maybe (Snowflake GuildChannel)
embedChannelID :: Maybe (Snowflake GuildChannel)
  , UpdatedGuild -> Int
verificationLevel :: Int
  , UpdatedGuild -> Int
defaultMessageNotifications :: Int
  , UpdatedGuild -> Int
explicitContentFilter :: Int
  , UpdatedGuild -> SnowflakeMap Role
roles :: SnowflakeMap Role
  , UpdatedGuild -> SnowflakeMap Emoji
emojis :: SnowflakeMap Emoji
  , UpdatedGuild -> [Text]
features :: [Text]
  , UpdatedGuild -> Int
mfaLevel :: Int
  , UpdatedGuild -> Maybe (Snowflake User)
applicationID :: Maybe (Snowflake User)
  , UpdatedGuild -> Maybe Bool
widgetEnabled :: Maybe Bool
  , UpdatedGuild -> Maybe (Snowflake GuildChannel)
widgetChannelID :: Maybe (Snowflake GuildChannel)
  , UpdatedGuild -> Maybe (Snowflake GuildChannel)
systemChannelID :: Maybe (Snowflake GuildChannel)
  }
  deriving (UpdatedGuild -> UpdatedGuild -> Bool
(UpdatedGuild -> UpdatedGuild -> Bool)
-> (UpdatedGuild -> UpdatedGuild -> Bool) -> Eq UpdatedGuild
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatedGuild -> UpdatedGuild -> Bool
$c/= :: UpdatedGuild -> UpdatedGuild -> Bool
== :: UpdatedGuild -> UpdatedGuild -> Bool
$c== :: UpdatedGuild -> UpdatedGuild -> Bool
Eq, Int -> UpdatedGuild -> ShowS
[UpdatedGuild] -> ShowS
UpdatedGuild -> String
(Int -> UpdatedGuild -> ShowS)
-> (UpdatedGuild -> String)
-> ([UpdatedGuild] -> ShowS)
-> Show UpdatedGuild
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatedGuild] -> ShowS
$cshowList :: [UpdatedGuild] -> ShowS
show :: UpdatedGuild -> String
$cshow :: UpdatedGuild -> String
showsPrec :: Int -> UpdatedGuild -> ShowS
$cshowsPrec :: Int -> UpdatedGuild -> ShowS
Show, (forall x. UpdatedGuild -> Rep UpdatedGuild x)
-> (forall x. Rep UpdatedGuild x -> UpdatedGuild)
-> Generic UpdatedGuild
forall x. Rep UpdatedGuild x -> UpdatedGuild
forall x. UpdatedGuild -> Rep UpdatedGuild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatedGuild x -> UpdatedGuild
$cfrom :: forall x. UpdatedGuild -> Rep UpdatedGuild x
Generic)
  deriving (Int -> UpdatedGuild -> Builder
Int -> UpdatedGuild -> Text
Int -> UpdatedGuild -> Text
[UpdatedGuild] -> Builder
[UpdatedGuild] -> Text
[UpdatedGuild] -> Text
UpdatedGuild -> Builder
UpdatedGuild -> Text
UpdatedGuild -> Text
(Int -> UpdatedGuild -> Builder)
-> (UpdatedGuild -> Builder)
-> ([UpdatedGuild] -> Builder)
-> (Int -> UpdatedGuild -> Text)
-> (UpdatedGuild -> Text)
-> ([UpdatedGuild] -> Text)
-> (Int -> UpdatedGuild -> Text)
-> (UpdatedGuild -> Text)
-> ([UpdatedGuild] -> Text)
-> TextShow UpdatedGuild
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [UpdatedGuild] -> Text
$cshowtlList :: [UpdatedGuild] -> Text
showtl :: UpdatedGuild -> Text
$cshowtl :: UpdatedGuild -> Text
showtlPrec :: Int -> UpdatedGuild -> Text
$cshowtlPrec :: Int -> UpdatedGuild -> Text
showtList :: [UpdatedGuild] -> Text
$cshowtList :: [UpdatedGuild] -> Text
showt :: UpdatedGuild -> Text
$cshowt :: UpdatedGuild -> Text
showtPrec :: Int -> UpdatedGuild -> Text
$cshowtPrec :: Int -> UpdatedGuild -> Text
showbList :: [UpdatedGuild] -> Builder
$cshowbList :: [UpdatedGuild] -> Builder
showb :: UpdatedGuild -> Builder
$cshowb :: UpdatedGuild -> Builder
showbPrec :: Int -> UpdatedGuild -> Builder
$cshowbPrec :: Int -> UpdatedGuild -> Builder
TextShow) via TSG.FromGeneric UpdatedGuild
  deriving (Value -> Parser [UpdatedGuild]
Value -> Parser UpdatedGuild
(Value -> Parser UpdatedGuild)
-> (Value -> Parser [UpdatedGuild]) -> FromJSON UpdatedGuild
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UpdatedGuild]
$cparseJSONList :: Value -> Parser [UpdatedGuild]
parseJSON :: Value -> Parser UpdatedGuild
$cparseJSON :: Value -> Parser UpdatedGuild
FromJSON) via CalamityJSON UpdatedGuild
  deriving (HasID Guild) via HasIDField "id" UpdatedGuild