{-# LANGUAGE TemplateHaskell #-}

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

import Calamity.Internal.SnowflakeMap (SnowflakeMap)
import qualified Calamity.Internal.SnowflakeMap as SM
import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=))
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild.Emoji
import 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 Data.Aeson ((.!=), (.:), (.:?))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as LH
import Data.Maybe
import Data.Text (Text)
import Data.Time
import Data.Word
import Optics
import qualified TextShow
import TextShow.TH (deriveTextShow)

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 -> 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
  , Guild -> Text
preferredLocale :: Text
  }
  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)
  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.TextShow) via TextShow.FromStringShow Guild
  deriving (HasID Guild) via HasIDField "id" Guild

instance Aeson.FromJSON Guild where
  parseJSON :: Value -> Parser Guild
parseJSON = String -> (Object -> Parser Guild) -> Value -> Parser Guild
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.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 -> Key -> Parser (Snowflake Guild)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

    SnowflakeMap Member
members' <- do
      [Object]
members' <- Object
v Object -> Key -> Parser [Object]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members"
      SnowflakeMap Member -> Parser (SnowflakeMap Member)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnowflakeMap Member -> Parser (SnowflakeMap Member))
-> ([Object] -> SnowflakeMap Member)
-> [Object]
-> Parser (SnowflakeMap Member)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Member] -> SnowflakeMap Member
forall a. HasID' a => [a] -> SnowflakeMap a
SM.fromList ([Member] -> SnowflakeMap Member)
-> ([Object] -> [Member]) -> [Object] -> SnowflakeMap Member
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Maybe Member) -> [Object] -> [Member]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Object -> Parser Member) -> Object -> Maybe Member
forall a b. (a -> Parser b) -> a -> Maybe b
Aeson.parseMaybe @Aeson.Object @Member (Value -> Parser Member
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Value -> Parser Member)
-> (Object -> Value) -> Object -> Parser Member
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Aeson.Object)) ([Object] -> Parser (SnowflakeMap Member))
-> [Object] -> Parser (SnowflakeMap Member)
forall a b. (a -> b) -> a -> b
$ [Object]
members'

    SnowflakeMap GuildChannel
channels' <- do
      [Object]
channels' <- Object
v Object -> Key -> Parser [Object]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
c -> Value -> Parser GuildChannel
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Value -> Parser GuildChannel) -> Value -> Parser GuildChannel
forall a b. (a -> b) -> a -> b
$ Object -> Value
Aeson.Object (Object
c Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key
"guild_id" Key -> Snowflake Guild -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Snowflake Guild
id)) [Object]
channels'

    HashMap (Snowflake User) Presence
presences' <- do
      [Object]
presences' <- Object
v Object -> Key -> Parser [Object]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"presences"
      HashMap (Snowflake User) Presence
-> Parser (HashMap (Snowflake User) Presence)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap (Snowflake User) Presence
 -> Parser (HashMap (Snowflake User) Presence))
-> ([Object] -> HashMap (Snowflake User) Presence)
-> [Object]
-> Parser (HashMap (Snowflake User) Presence)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(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)
-> ([Object] -> [(Snowflake User, Presence)])
-> [Object]
-> HashMap (Snowflake User) Presence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Maybe (Snowflake User, Presence))
-> [Object] -> [(Snowflake User, Presence)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          ( (Object -> Parser (Snowflake User, Presence))
-> Object -> Maybe (Snowflake User, Presence)
forall a b. (a -> Parser b) -> a -> Maybe b
Aeson.parseMaybe @Aeson.Object @(Snowflake User, Presence)
              ( \Object
m -> do
                  Presence
p <- Value -> Parser Presence
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Value -> Parser Presence) -> Value -> Parser Presence
forall a b. (a -> b) -> a -> b
$ Object -> Value
Aeson.Object (Object
m Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Key
"guild_id" Key -> Snowflake Guild -> Object
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= 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
-> Optic' A_Lens NoIx Presence (Snowflake User) -> Snowflake User
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall k s t a b.
LabelOptic "user" k s t a b =>
Optic k NoIx s t a b
forall (name :: Symbol) k s t a b.
LabelOptic name k s t a b =>
Optic k NoIx s t a b
labelOptic @"user", Presence
p)
              )
          )
        ([Object] -> Parser (HashMap (Snowflake User) Presence))
-> [Object] -> Parser (HashMap (Snowflake User) Presence)
forall a b. (a -> b) -> a -> b
$ [Object]
presences'

    Snowflake Guild
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Snowflake User
-> Word64
-> 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
-> Text
-> Guild
Guild Snowflake Guild
id
      (Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Snowflake User
 -> Word64
 -> 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
 -> Text
 -> Guild)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Word64
      -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Word64
   -> 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
   -> Text
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Word64
      -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"icon"
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Word64
   -> 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
   -> Text
   -> Guild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Snowflake User
      -> Word64
      -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"splash"
      Parser
  (Maybe Bool
   -> Snowflake User
   -> Word64
   -> 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
   -> Text
   -> Guild)
-> Parser (Maybe Bool)
-> Parser
     (Snowflake User
      -> Word64
      -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner"
      Parser
  (Snowflake User
   -> Word64
   -> 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
   -> Text
   -> Guild)
-> Parser (Snowflake User)
-> Parser
     (Word64
      -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Snowflake User)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_id"
      Parser
  (Word64
   -> 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
   -> Text
   -> Guild)
-> Parser Word64
-> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions" Parser (Maybe Word64) -> Word64 -> Parser Word64
forall a. Parser (Maybe a) -> a -> Parser a
.!= Word64
0
      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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (SnowflakeMap Role)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (SnowflakeMap Emoji)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
   -> Text
   -> 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
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake User))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"application_id"
      Parser
  (Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser Bool
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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
   -> Text
   -> Guild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_channel_id"
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Maybe UTCTime
      -> Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system_channel_id"
      Parser
  (Maybe UTCTime
   -> Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser (Maybe UTCTime)
-> Parser
     (Bool
      -> Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"joined_at"
      Parser
  (Bool
   -> Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser Bool
-> Parser
     (Bool
      -> Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"large"
      Parser
  (Bool
   -> Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser Bool
-> Parser
     (Int
      -> [VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unavailable" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser
  (Int
   -> [VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser Int
-> Parser
     ([VoiceState]
      -> SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"member_count"
      Parser
  ([VoiceState]
   -> SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser [VoiceState]
-> Parser
     (SnowflakeMap Member
      -> SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence
      -> Text
      -> Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [VoiceState]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"voice_states"
      Parser
  (SnowflakeMap Member
   -> SnowflakeMap GuildChannel
   -> HashMap (Snowflake User) Presence
   -> Text
   -> Guild)
-> Parser (SnowflakeMap Member)
-> Parser
     (SnowflakeMap GuildChannel
      -> HashMap (Snowflake User) Presence -> Text -> 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 -> Text -> Guild)
-> Parser (SnowflakeMap GuildChannel)
-> Parser (HashMap (Snowflake User) Presence -> Text -> 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 -> Text -> Guild)
-> Parser (HashMap (Snowflake User) Presence)
-> Parser (Text -> 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'
      Parser (Text -> Guild) -> Parser Text -> Parser Guild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"preferred_locale"

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)
  deriving (HasID Guild) via HasIDField "id" (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
Aeson.ToJSON) via CalamityToJSON (Partial Guild)

instance CalamityToJSON' (Partial Guild) where
  toPairs :: Partial Guild -> [Maybe kv]
toPairs PartialGuild {..} =
    [ Key
"id" Key -> Snowflake Guild -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Snowflake Guild
id
    , Key
"name" Key -> Text -> Maybe kv
forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Text
name
    ]

instance Aeson.FromJSON (Partial Guild) where
  parseJSON :: Value -> Parser (Partial Guild)
parseJSON = String
-> (Object -> Parser (Partial Guild))
-> Value
-> Parser (Partial Guild)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Partial Guild" ((Object -> Parser (Partial Guild))
 -> Value -> Parser (Partial Guild))
-> (Object -> Parser (Partial Guild))
-> Value
-> Parser (Partial Guild)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake Guild -> Text -> Partial Guild
PartialGuild
      (Snowflake Guild -> Text -> Partial Guild)
-> Parser (Snowflake Guild) -> Parser (Text -> Partial Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake Guild)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser (Text -> Partial Guild)
-> Parser Text -> Parser (Partial Guild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

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 -> 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)
  , UpdatedGuild -> Text
preferredLocale :: Text
  }
  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)
  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.TextShow) via TextShow.FromStringShow UpdatedGuild
  deriving (HasID Guild) via HasIDField "id" UpdatedGuild

instance Aeson.FromJSON UpdatedGuild where
  parseJSON :: Value -> Parser UpdatedGuild
parseJSON = String
-> (Object -> Parser UpdatedGuild) -> Value -> Parser UpdatedGuild
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Guild" ((Object -> Parser UpdatedGuild) -> Value -> Parser UpdatedGuild)
-> (Object -> Parser UpdatedGuild) -> Value -> Parser UpdatedGuild
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Snowflake Guild
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Snowflake User
-> Maybe Word64
-> Maybe (Snowflake GuildChannel)
-> Int
-> Maybe Bool
-> Maybe (Snowflake GuildChannel)
-> Int
-> Int
-> Int
-> SnowflakeMap Role
-> SnowflakeMap Emoji
-> [Text]
-> Int
-> Maybe (Snowflake User)
-> Maybe Bool
-> Maybe (Snowflake GuildChannel)
-> Maybe (Snowflake GuildChannel)
-> Text
-> UpdatedGuild
UpdatedGuild
      (Snowflake Guild
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Snowflake User
 -> Maybe Word64
 -> Maybe (Snowflake GuildChannel)
 -> Int
 -> Maybe Bool
 -> Maybe (Snowflake GuildChannel)
 -> Int
 -> Int
 -> Int
 -> SnowflakeMap Role
 -> SnowflakeMap Emoji
 -> [Text]
 -> Int
 -> Maybe (Snowflake User)
 -> Maybe Bool
 -> Maybe (Snowflake GuildChannel)
 -> Maybe (Snowflake GuildChannel)
 -> Text
 -> UpdatedGuild)
-> Parser (Snowflake Guild)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Maybe Word64
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Snowflake Guild)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Maybe Word64
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Maybe Word64
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Maybe Word64
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Snowflake User
      -> Maybe Word64
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"icon"
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Snowflake User
   -> Maybe Word64
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Snowflake User
      -> Maybe Word64
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"splash"
      Parser
  (Maybe Bool
   -> Snowflake User
   -> Maybe Word64
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe Bool)
-> Parser
     (Snowflake User
      -> Maybe Word64
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner"
      Parser
  (Snowflake User
   -> Maybe Word64
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Snowflake User)
-> Parser
     (Maybe Word64
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Snowflake User)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_id"
      Parser
  (Maybe Word64
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe Word64)
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions"
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Int
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"afk_channel_id"
      Parser
  (Int
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser Int
-> Parser
     (Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"afk_timeout"
      Parser
  (Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"embed_enabled"
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser
     (Int
      -> Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"embed_channel_id"
      Parser
  (Int
   -> Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"verification_level"
      Parser
  (Int
   -> Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser Int
-> Parser
     (Int
      -> SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default_message_notifications"
      Parser
  (Int
   -> SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser Int
-> Parser
     (SnowflakeMap Role
      -> SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"explicit_content_filter"
      Parser
  (SnowflakeMap Role
   -> SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (SnowflakeMap Role)
-> Parser
     (SnowflakeMap Emoji
      -> [Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (SnowflakeMap Role)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"roles"
      Parser
  (SnowflakeMap Emoji
   -> [Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (SnowflakeMap Emoji)
-> Parser
     ([Text]
      -> Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (SnowflakeMap Emoji)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emojis"
      Parser
  ([Text]
   -> Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser [Text]
-> Parser
     (Int
      -> Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"features"
      Parser
  (Int
   -> Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser Int
-> Parser
     (Maybe (Snowflake User)
      -> Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mfa_level"
      Parser
  (Maybe (Snowflake User)
   -> Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe (Snowflake User))
-> Parser
     (Maybe Bool
      -> Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel)
      -> Text
      -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake User))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"application_id"
      Parser
  (Maybe Bool
   -> Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel)
   -> Text
   -> UpdatedGuild)
-> Parser (Maybe Bool)
-> Parser
     (Maybe (Snowflake GuildChannel)
      -> Maybe (Snowflake GuildChannel) -> Text -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_enabled"
      Parser
  (Maybe (Snowflake GuildChannel)
   -> Maybe (Snowflake GuildChannel) -> Text -> UpdatedGuild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser (Maybe (Snowflake GuildChannel) -> Text -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_channel_id"
      Parser (Maybe (Snowflake GuildChannel) -> Text -> UpdatedGuild)
-> Parser (Maybe (Snowflake GuildChannel))
-> Parser (Text -> UpdatedGuild)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (Snowflake GuildChannel))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system_channel_id"
      Parser (Text -> UpdatedGuild) -> Parser Text -> Parser UpdatedGuild
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"preferred_locale"

$(deriveTextShow 'PartialGuild)

$(makeFieldLabelsNoPrefix ''Guild)
$(makeFieldLabelsNoPrefix 'PartialGuild)
$(makeFieldLabelsNoPrefix ''UpdatedGuild)