{-# LANGUAGE OverloadedStrings #-}
module Discord.Internal.Types.Events where
import Prelude hiding (id)
import Data.Time.ISO8601 (parseISO8601)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Text as T
import Discord.Internal.Types.Prelude
import Discord.Internal.Types.Channel
import Discord.Internal.Types.Guild
data Event =
Ready Int User [Channel] [GuildUnavailable] T.Text
| Resumed [T.Text]
| ChannelCreate Channel
| ChannelUpdate Channel
| ChannelDelete Channel
| ChannelPinsUpdate ChannelId (Maybe UTCTime)
| GuildCreate Guild GuildInfo
| GuildUpdate Guild
| GuildDelete GuildUnavailable
| GuildBanAdd GuildId User
| GuildBanRemove GuildId User
| GuildEmojiUpdate GuildId [Emoji]
| GuildIntegrationsUpdate GuildId
| GuildMemberAdd GuildId GuildMember
| GuildMemberRemove GuildId User
| GuildMemberUpdate GuildId [RoleId] User (Maybe T.Text)
| GuildMemberChunk GuildId [GuildMember]
| GuildRoleCreate GuildId Role
| GuildRoleUpdate GuildId Role
| GuildRoleDelete GuildId RoleId
| MessageCreate Message
| MessageUpdate ChannelId MessageId
| MessageDelete ChannelId MessageId
| MessageDeleteBulk ChannelId [MessageId]
| MessageReactionAdd ReactionInfo
| MessageReactionRemove ReactionInfo
| MessageReactionRemoveAll ChannelId MessageId
| PresenceUpdate PresenceInfo
| TypingStart TypingInfo
| UserUpdate User
| UnknownEvent T.Text Object
deriving (Show, Eq)
data ReactionInfo = ReactionInfo
{ reactionUserId :: UserId
, reactionChannelId :: ChannelId
, reactionMessageId :: MessageId
, reactionEmoji :: Emoji
} deriving (Show, Eq, Ord)
instance FromJSON ReactionInfo where
parseJSON = withObject "ReactionInfo" $ \o ->
ReactionInfo <$> o .: "user_id"
<*> o .: "channel_id"
<*> o .: "message_id"
<*> o .: "emoji"
data PresenceInfo = PresenceInfo
{ presenceUserId :: UserId
, presenceRoles :: [RoleId]
, presenceGuildId :: GuildId
, presenceStatus :: T.Text
} deriving (Show, Eq, Ord)
instance FromJSON PresenceInfo where
parseJSON = withObject "PresenceInfo" $ \o ->
PresenceInfo <$> (o .: "user" >>= (.: "id"))
<*> o .: "roles"
<*> o .: "guild_id"
<*> o .: "status"
data TypingInfo = TypingInfo
{ typingUserId :: UserId
, typingChannelId :: ChannelId
, typingTimestamp :: UTCTime
} deriving (Show, Eq, Ord)
instance FromJSON TypingInfo where
parseJSON = withObject "TypingInfo" $ \o ->
do cid <- o .: "channel_id"
uid <- o .: "user_id"
posix <- o .: "timestamp"
let utc = posixSecondsToUTCTime posix
pure (TypingInfo uid cid utc)
reparse :: (ToJSON a, FromJSON b) => a -> Parser b
reparse val = case parseEither parseJSON $ toJSON val of
Left r -> fail r
Right b -> pure b
eventParse :: T.Text -> Object -> Parser Event
eventParse t o = case t of
"READY" -> Ready <$> o .: "v"
<*> o .: "user"
<*> o .: "private_channels"
<*> o .: "guilds"
<*> o .: "session_id"
"RESUMED" -> Resumed <$> o .: "_trace"
"CHANNEL_CREATE" -> ChannelCreate <$> reparse o
"CHANNEL_UPDATE" -> ChannelUpdate <$> reparse o
"CHANNEL_DELETE" -> ChannelDelete <$> reparse o
"CHANNEL_PINS_UPDATE" -> do id <- o .: "channel_id"
stamp <- o .:? "last_pin_timestamp"
let utc = stamp >>= parseISO8601
pure (ChannelPinsUpdate id utc)
"GUILD_CREATE" -> GuildCreate <$> reparse o <*> reparse o
"GUILD_UPDATE" -> GuildUpdate <$> reparse o
"GUILD_DELETE" -> GuildDelete <$> reparse o
"GUILD_BAN_ADD" -> GuildBanAdd <$> o .: "guild_id" <*> o .: "user"
"GUILD_BAN_REMOVE" -> GuildBanRemove <$> o .: "guild_id" <*> o .: "user"
"GUILD_EMOJI_UPDATE" -> GuildEmojiUpdate <$> o .: "guild_id" <*> o .: "emojis"
"GUILD_INTEGRATIONS_UPDATE" -> GuildIntegrationsUpdate <$> o .: "guild_id"
"GUILD_MEMBER_ADD" -> GuildMemberAdd <$> o .: "guild_id" <*> reparse o
"GUILD_MEMBER_REMOVE" -> GuildMemberRemove <$> o .: "guild_id" <*> o .: "user"
"GUILD_MEMBER_UPDATE" -> GuildMemberUpdate <$> o .: "guild_id"
<*> o .: "roles"
<*> o .: "user"
<*> o .:? "nick"
"GUILD_MEMBERS_CHUNK" -> GuildMemberChunk <$> o .: "guild_id" <*> o .: "members"
"GUILD_ROLE_CREATE" -> GuildRoleCreate <$> o .: "guild_id" <*> o .: "role"
"GUILD_ROLE_UPDATE" -> GuildRoleUpdate <$> o .: "guild_id" <*> o .: "role"
"GUILD_ROLE_DELETE" -> GuildRoleDelete <$> o .: "guild_id" <*> o .: "role_id"
"MESSAGE_CREATE" -> MessageCreate <$> reparse o
"MESSAGE_UPDATE" -> MessageUpdate <$> o .: "channel_id" <*> o .: "id"
"MESSAGE_DELETE" -> MessageDelete <$> o .: "channel_id" <*> o .: "id"
"MESSAGE_DELETE_BULK" -> MessageDeleteBulk <$> o .: "channel_id" <*> o .: "ids"
"MESSAGE_REACTION_ADD" -> MessageReactionAdd <$> reparse o
"MESSAGE_REACTION_REMOVE" -> MessageReactionRemove <$> reparse o
"MESSAGE_REACTION_REMOVE_ALL" -> MessageReactionRemoveAll <$> o .: "channel_id"
<*> o .: "message_id"
"PRESENCE_UPDATE" -> PresenceUpdate <$> reparse o
"TYPING_START" -> TypingStart <$> reparse o
"USER_UPDATE" -> UserUpdate <$> reparse o
_other_event -> UnknownEvent t <$> reparse o