{-# LANGUAGE TemplateHaskell #-}

-- | Discord Guilds
module Calamity.Types.Model.Guild.Guild (
  Guild (..),
  GuildIcon (..),
  GuildSplash (..),
  GuildDiscoverySplash (..),
  GuildBanner (..),
  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.CDNAsset (CDNAsset (..))
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 Calamity.Utils.CDNUrl (assetHashFile, cdnURL)
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 qualified Data.Text as T
import Data.Time
import Data.Word
import Network.HTTP.Req ((/:), (/~))
import Optics
import qualified TextShow
import TextShow.TH (deriveTextShow)

data GuildIcon = GuildIcon
  { GuildIcon -> Snowflake Guild
guildID :: Snowflake Guild
  , GuildIcon -> Text
hash :: T.Text
  }
  deriving (Int -> GuildIcon -> ShowS
[GuildIcon] -> ShowS
GuildIcon -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildIcon] -> ShowS
$cshowList :: [GuildIcon] -> ShowS
show :: GuildIcon -> String
$cshow :: GuildIcon -> String
showsPrec :: Int -> GuildIcon -> ShowS
$cshowsPrec :: Int -> GuildIcon -> ShowS
Show, GuildIcon -> GuildIcon -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildIcon -> GuildIcon -> Bool
$c/= :: GuildIcon -> GuildIcon -> Bool
== :: GuildIcon -> GuildIcon -> Bool
$c== :: GuildIcon -> GuildIcon -> Bool
Eq)

instance CDNAsset GuildIcon where
  assetURL :: GuildIcon -> Url 'Https
assetURL GuildIcon {Text
hash :: Text
$sel:hash:GuildIcon :: GuildIcon -> Text
hash, Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildIcon :: GuildIcon -> Snowflake Guild
guildID} =
    Url 'Https
cdnURL forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"icons" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Snowflake Guild
guildID forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text -> Text
assetHashFile Text
hash

data GuildSplash = GuildSplash
  { GuildSplash -> Snowflake Guild
guildID :: Snowflake Guild
  , GuildSplash -> Text
hash :: T.Text
  }
  deriving (Int -> GuildSplash -> ShowS
[GuildSplash] -> ShowS
GuildSplash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildSplash] -> ShowS
$cshowList :: [GuildSplash] -> ShowS
show :: GuildSplash -> String
$cshow :: GuildSplash -> String
showsPrec :: Int -> GuildSplash -> ShowS
$cshowsPrec :: Int -> GuildSplash -> ShowS
Show, GuildSplash -> GuildSplash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildSplash -> GuildSplash -> Bool
$c/= :: GuildSplash -> GuildSplash -> Bool
== :: GuildSplash -> GuildSplash -> Bool
$c== :: GuildSplash -> GuildSplash -> Bool
Eq)

instance CDNAsset GuildSplash where
  assetURL :: GuildSplash -> Url 'Https
assetURL GuildSplash {Text
hash :: Text
$sel:hash:GuildSplash :: GuildSplash -> Text
hash, Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildSplash :: GuildSplash -> Snowflake Guild
guildID} =
    Url 'Https
cdnURL forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"splashes" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Snowflake Guild
guildID forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text -> Text
assetHashFile Text
hash

data GuildDiscoverySplash = GuildDiscoverySplash
  { GuildDiscoverySplash -> Snowflake Guild
guildID :: Snowflake Guild
  , GuildDiscoverySplash -> Text
hash :: T.Text
  }
  deriving (Int -> GuildDiscoverySplash -> ShowS
[GuildDiscoverySplash] -> ShowS
GuildDiscoverySplash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildDiscoverySplash] -> ShowS
$cshowList :: [GuildDiscoverySplash] -> ShowS
show :: GuildDiscoverySplash -> String
$cshow :: GuildDiscoverySplash -> String
showsPrec :: Int -> GuildDiscoverySplash -> ShowS
$cshowsPrec :: Int -> GuildDiscoverySplash -> ShowS
Show, GuildDiscoverySplash -> GuildDiscoverySplash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildDiscoverySplash -> GuildDiscoverySplash -> Bool
$c/= :: GuildDiscoverySplash -> GuildDiscoverySplash -> Bool
== :: GuildDiscoverySplash -> GuildDiscoverySplash -> Bool
$c== :: GuildDiscoverySplash -> GuildDiscoverySplash -> Bool
Eq)

instance CDNAsset GuildDiscoverySplash where
  assetURL :: GuildDiscoverySplash -> Url 'Https
assetURL GuildDiscoverySplash {Text
hash :: Text
$sel:hash:GuildDiscoverySplash :: GuildDiscoverySplash -> Text
hash, Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildDiscoverySplash :: GuildDiscoverySplash -> Snowflake Guild
guildID} =
    Url 'Https
cdnURL forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"discovery-splashes" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Snowflake Guild
guildID forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text -> Text
assetHashFile Text
hash

data GuildBanner = GuildBanner
  { GuildBanner -> Snowflake Guild
guildID :: Snowflake Guild
  , GuildBanner -> Text
hash :: T.Text
  }
  deriving (Int -> GuildBanner -> ShowS
[GuildBanner] -> ShowS
GuildBanner -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildBanner] -> ShowS
$cshowList :: [GuildBanner] -> ShowS
show :: GuildBanner -> String
$cshow :: GuildBanner -> String
showsPrec :: Int -> GuildBanner -> ShowS
$cshowsPrec :: Int -> GuildBanner -> ShowS
Show, GuildBanner -> GuildBanner -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildBanner -> GuildBanner -> Bool
$c/= :: GuildBanner -> GuildBanner -> Bool
== :: GuildBanner -> GuildBanner -> Bool
$c== :: GuildBanner -> GuildBanner -> Bool
Eq)

instance CDNAsset GuildBanner where
  assetURL :: GuildBanner -> Url 'Https
assetURL GuildBanner {Text
hash :: Text
$sel:hash:GuildBanner :: GuildBanner -> Text
hash, Snowflake Guild
guildID :: Snowflake Guild
$sel:guildID:GuildBanner :: GuildBanner -> Snowflake Guild
guildID} =
    Url 'Https
cdnURL forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"banners" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ Snowflake Guild
guildID forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text -> Text
assetHashFile Text
hash

data Guild = Guild
  { Guild -> Snowflake Guild
id :: Snowflake Guild
  , Guild -> Text
name :: T.Text
  , Guild -> Maybe GuildIcon
icon :: Maybe GuildIcon
  , Guild -> Maybe GuildSplash
splash :: Maybe GuildSplash
  , Guild -> Maybe GuildSplash
discoverySplash :: Maybe GuildSplash
  , Guild -> Maybe GuildBanner
banner :: Maybe GuildBanner
  , 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 :: [T.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 :: T.Text
  }
  deriving (Guild -> Guild -> Bool
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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Guild" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Snowflake Guild
id <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

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

    SnowflakeMap GuildChannel
channels' <- do
      [Object]
channels' <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channels"
      forall a. HasID' a => [a] -> SnowflakeMap a
SM.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Object
c -> forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON forall a b. (a -> b) -> a -> b
$ Object -> Value
Aeson.Object (Object
c forall a. Semigroup a => a -> a -> a
<> Key
"guild_id" 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"presences"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          ( forall a b. (a -> Parser b) -> a -> Maybe b
Aeson.parseMaybe @Aeson.Object @(Snowflake User, Presence)
              ( \Object
m -> do
                  Presence
p <- forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON forall a b. (a -> b) -> a -> b
$ Object -> Value
Aeson.Object (Object
m forall a. Semigroup a => a -> a -> a
<> Key
"guild_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Snowflake Guild
id)
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b a. HasID b a => a -> Snowflake b
getID forall a b. (a -> b) -> a -> b
$ Presence
p forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. 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)
              )
          )
        forall a b. (a -> b) -> a -> b
$ [Object]
presences'

    Maybe GuildIcon
icon <- (Snowflake Guild -> Text -> GuildIcon
GuildIcon Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"icon"
    Maybe GuildSplash
splash <- (Snowflake Guild -> Text -> GuildSplash
GuildSplash Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"splash"
    Maybe GuildSplash
discoverySplash <- (Snowflake Guild -> Text -> GuildSplash
GuildSplash Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"discovery_splash"
    Maybe GuildBanner
banner <- (Snowflake Guild -> Text -> GuildBanner
GuildBanner Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"banner"

    Snowflake Guild
-> Text
-> Maybe GuildIcon
-> Maybe GuildSplash
-> Maybe GuildSplash
-> Maybe GuildBanner
-> 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildIcon
icon
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildSplash
splash
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildSplash
discoverySplash
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildBanner
banner
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions" forall a. Parser (Maybe a) -> a -> Parser a
.!= Word64
0
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"afk_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"afk_timeout"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"embed_enabled" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"embed_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"verification_level"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default_message_notifications"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"explicit_content_filter"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"roles"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emojis"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"features"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mfa_level"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"application_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_enabled" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"joined_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"large"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unavailable" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"member_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"voice_states"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SnowflakeMap Member
members'
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure SnowflakeMap GuildChannel
channels'
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap (Snowflake User) Presence
presences'
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v 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 :: T.Text
  }
  deriving (Partial Guild -> Partial Guild -> Bool
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
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
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 :: forall kv. KeyValue kv => Partial Guild -> [Maybe kv]
toPairs PartialGuild {Text
Snowflake Guild
name :: Text
id :: Snowflake Guild
$sel:name:PartialGuild :: Partial Guild -> Text
$sel:id:PartialGuild :: Partial Guild -> Snowflake Guild
..} =
    [ Key
"id" forall v kv. (ToJSON v, KeyValue kv) => Key -> v -> Maybe kv
.= Snowflake Guild
id
    , Key
"name" 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Partial Guild" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Snowflake Guild -> Text -> Partial Guild
PartialGuild
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

data UpdatedGuild = UpdatedGuild
  { UpdatedGuild -> Snowflake Guild
id :: Snowflake Guild
  , UpdatedGuild -> Text
name :: T.Text
  , UpdatedGuild -> Maybe GuildIcon
icon :: Maybe GuildIcon
  , UpdatedGuild -> Maybe GuildSplash
splash :: Maybe GuildSplash
  , UpdatedGuild -> Maybe GuildSplash
discoverySplash :: Maybe GuildSplash
  , UpdatedGuild -> Maybe GuildBanner
banner :: Maybe GuildBanner
  , 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 :: [T.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 :: T.Text
  }
  deriving (UpdatedGuild -> UpdatedGuild -> Bool
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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Guild" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Snowflake Guild
id <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Maybe GuildIcon
icon <- (Snowflake Guild -> Text -> GuildIcon
GuildIcon Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"icon"
    Maybe GuildSplash
splash <- (Snowflake Guild -> Text -> GuildSplash
GuildSplash Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"splash"
    Maybe GuildSplash
discoverySplash <- (Snowflake Guild -> Text -> GuildSplash
GuildSplash Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"discovery_splash"
    Maybe GuildBanner
banner <- (Snowflake Guild -> Text -> GuildBanner
GuildBanner Snowflake Guild
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"banner"

    Snowflake Guild
-> Text
-> Maybe GuildIcon
-> Maybe GuildSplash
-> Maybe GuildSplash
-> Maybe GuildBanner
-> 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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildIcon
icon
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildSplash
splash
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildSplash
discoverySplash
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GuildBanner
banner
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"afk_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"afk_timeout"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"embed_enabled"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"embed_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"verification_level"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default_message_notifications"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"explicit_content_filter"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"roles"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emojis"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"features"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mfa_level"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"application_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_enabled"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"widget_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system_channel_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"preferred_locale"

$(deriveTextShow ''GuildIcon)
$(deriveTextShow 'PartialGuild)

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