{-# LANGUAGE OverloadedStrings #-}

-- | Data structures pertaining to gateway dispatch 'Event's
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
import Discord.Internal.Types.User (User, GuildMember)
import Discord.Internal.Types.Interactions (Interaction)
import Discord.Internal.Types.Emoji (Emoji)


-- | Represents possible events sent by discord. Detailed information can be found at <https://discord.com/developers/docs/topics/gateway>.
data Event =
  -- | Contains the initial state information
    Ready                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication
  -- | Response to a @Resume@ gateway command
  | Resumed                    [T.Text]
  -- | new guild channel created
  | ChannelCreate              Channel
  -- | channel was updated
  | ChannelUpdate              Channel
  -- | channel was deleted
  | ChannelDelete              Channel
  -- | thread created, also sent when being added to a private thread
  | ThreadCreate               Channel
  -- | thread was updated
  | ThreadUpdate               Channel
  -- | thread was deleted
  | ThreadDelete               Channel
  -- | sent when gaining access to a channel, contains all active threads in that channel
  | ThreadListSync             ThreadListSyncFields
  -- | thread member for the current user was updated
  | ThreadMembersUpdate        ThreadMembersUpdateFields
  -- | message was pinned or unpinned
  | ChannelPinsUpdate          ChannelId (Maybe UTCTime)
  -- | lazy-load for unavailable guild, guild became available, or user joined a new guild
  | GuildCreate                Guild
  -- | guild was updated
  | GuildUpdate                Guild
  -- | guild became unavailable, or user left/was removed from a guild
  | GuildDelete                GuildUnavailable
  -- | user was banned from a guild
  | GuildBanAdd                GuildId User
  -- | user was unbanned from a guild
  | GuildBanRemove             GuildId User
  -- | guild emojis were updated
  | GuildEmojiUpdate           GuildId [Emoji]
  -- | guild integration was updated
  | GuildIntegrationsUpdate    GuildId
  -- | new user joined a guild
  | GuildMemberAdd             GuildId GuildMember
  -- | user was removed from a guild
  | GuildMemberRemove          GuildId User
  -- | guild member was updated
  | GuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)
  -- | response to @Request Guild Members@ gateway command
  | GuildMemberChunk           GuildId [GuildMember]
  -- | guild role was created
  | GuildRoleCreate            GuildId Role
  -- | guild role was updated
  | GuildRoleUpdate            GuildId Role
  -- | guild role was deleted
  | GuildRoleDelete            GuildId RoleId
  -- | message was created
  | MessageCreate              Message
  -- | message was updated
  | MessageUpdate              ChannelId MessageId
  -- | message was deleted
  | MessageDelete              ChannelId MessageId
  -- | multiple messages were deleted at once
  | MessageDeleteBulk          ChannelId [MessageId]
  -- | user reacted to a message
  | MessageReactionAdd         ReactionInfo
  -- | user removed a reaction from a message
  | MessageReactionRemove      ReactionInfo
  -- | all reactions were explicitly removed from a message
  | MessageReactionRemoveAll   ChannelId MessageId
  -- | all reactions for a given emoji were explicitly removed from a message
  | MessageReactionRemoveEmoji ReactionRemoveInfo
  -- | user was updated
  | PresenceUpdate             PresenceInfo
  -- | user started typing in a channel
  | TypingStart                TypingInfo
  -- | properties about the user changed
  | UserUpdate                 User
  -- | someone joined, left, or moved a voice channel
  | InteractionCreate          Interaction
  --  | VoiceStateUpdate
  --  | VoiceServerUpdate
  -- | An Unknown Event, none of the others
  | UnknownEvent               T.Text Object
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

-- | Internal Event representation. Each matches to the corresponding constructor of `Event`.
--
-- An application should never have to use those directly
data EventInternalParse =
    InternalReady                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication
  | InternalResumed                    [T.Text]
  | InternalChannelCreate              Channel
  | InternalChannelUpdate              Channel
  | InternalChannelDelete              Channel
  | InternalThreadCreate               Channel
  | InternalThreadUpdate               Channel
  | InternalThreadDelete               Channel
  | InternalThreadListSync             ThreadListSyncFields 
  | InternalThreadMembersUpdate        ThreadMembersUpdateFields 
  | InternalChannelPinsUpdate          ChannelId (Maybe UTCTime)
  | InternalGuildCreate                Guild
  | InternalGuildUpdate                Guild
  | InternalGuildDelete                GuildUnavailable
  | InternalGuildBanAdd                GuildId User
  | InternalGuildBanRemove             GuildId User
  | InternalGuildEmojiUpdate           GuildId [Emoji]
  | InternalGuildIntegrationsUpdate    GuildId
  | InternalGuildMemberAdd             GuildId GuildMember
  | InternalGuildMemberRemove          GuildId User
  | InternalGuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)
  | InternalGuildMemberChunk           GuildId [GuildMember]
  | InternalGuildRoleCreate            GuildId Role
  | InternalGuildRoleUpdate            GuildId Role
  | InternalGuildRoleDelete            GuildId RoleId
  | InternalMessageCreate              Message
  | InternalMessageUpdate              ChannelId MessageId
  | InternalMessageDelete              ChannelId MessageId
  | InternalMessageDeleteBulk          ChannelId [MessageId]
  | InternalMessageReactionAdd         ReactionInfo
  | InternalMessageReactionRemove      ReactionInfo
  | InternalMessageReactionRemoveAll   ChannelId MessageId
  | InternalMessageReactionRemoveEmoji ReactionRemoveInfo
  | InternalPresenceUpdate             PresenceInfo
  | InternalTypingStart                TypingInfo
  | InternalUserUpdate                 User
  | InternalInteractionCreate          Interaction
  --  | InternalVoiceStateUpdate
  --  | InternalVoiceServerUpdate
  | InternalUnknownEvent               T.Text Object
  deriving (Int -> EventInternalParse -> ShowS
[EventInternalParse] -> ShowS
EventInternalParse -> String
(Int -> EventInternalParse -> ShowS)
-> (EventInternalParse -> String)
-> ([EventInternalParse] -> ShowS)
-> Show EventInternalParse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventInternalParse] -> ShowS
$cshowList :: [EventInternalParse] -> ShowS
show :: EventInternalParse -> String
$cshow :: EventInternalParse -> String
showsPrec :: Int -> EventInternalParse -> ShowS
$cshowsPrec :: Int -> EventInternalParse -> ShowS
Show, EventInternalParse -> EventInternalParse -> Bool
(EventInternalParse -> EventInternalParse -> Bool)
-> (EventInternalParse -> EventInternalParse -> Bool)
-> Eq EventInternalParse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventInternalParse -> EventInternalParse -> Bool
$c/= :: EventInternalParse -> EventInternalParse -> Bool
== :: EventInternalParse -> EventInternalParse -> Bool
$c== :: EventInternalParse -> EventInternalParse -> Bool
Eq, ReadPrec [EventInternalParse]
ReadPrec EventInternalParse
Int -> ReadS EventInternalParse
ReadS [EventInternalParse]
(Int -> ReadS EventInternalParse)
-> ReadS [EventInternalParse]
-> ReadPrec EventInternalParse
-> ReadPrec [EventInternalParse]
-> Read EventInternalParse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EventInternalParse]
$creadListPrec :: ReadPrec [EventInternalParse]
readPrec :: ReadPrec EventInternalParse
$creadPrec :: ReadPrec EventInternalParse
readList :: ReadS [EventInternalParse]
$creadList :: ReadS [EventInternalParse]
readsPrec :: Int -> ReadS EventInternalParse
$creadsPrec :: Int -> ReadS EventInternalParse
Read)

-- | Structure containing partial information about an Application
data PartialApplication = PartialApplication
  { PartialApplication -> ApplicationId
partialApplicationID :: ApplicationId
  , PartialApplication -> Int
partialApplicationFlags :: Int
  } deriving (Int -> PartialApplication -> ShowS
[PartialApplication] -> ShowS
PartialApplication -> String
(Int -> PartialApplication -> ShowS)
-> (PartialApplication -> String)
-> ([PartialApplication] -> ShowS)
-> Show PartialApplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialApplication] -> ShowS
$cshowList :: [PartialApplication] -> ShowS
show :: PartialApplication -> String
$cshow :: PartialApplication -> String
showsPrec :: Int -> PartialApplication -> ShowS
$cshowsPrec :: Int -> PartialApplication -> ShowS
Show, PartialApplication -> PartialApplication -> Bool
(PartialApplication -> PartialApplication -> Bool)
-> (PartialApplication -> PartialApplication -> Bool)
-> Eq PartialApplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialApplication -> PartialApplication -> Bool
$c/= :: PartialApplication -> PartialApplication -> Bool
== :: PartialApplication -> PartialApplication -> Bool
$c== :: PartialApplication -> PartialApplication -> Bool
Eq, ReadPrec [PartialApplication]
ReadPrec PartialApplication
Int -> ReadS PartialApplication
ReadS [PartialApplication]
(Int -> ReadS PartialApplication)
-> ReadS [PartialApplication]
-> ReadPrec PartialApplication
-> ReadPrec [PartialApplication]
-> Read PartialApplication
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PartialApplication]
$creadListPrec :: ReadPrec [PartialApplication]
readPrec :: ReadPrec PartialApplication
$creadPrec :: ReadPrec PartialApplication
readList :: ReadS [PartialApplication]
$creadList :: ReadS [PartialApplication]
readsPrec :: Int -> ReadS PartialApplication
$creadsPrec :: Int -> ReadS PartialApplication
Read)

instance FromJSON PartialApplication where
  parseJSON :: Value -> Parser PartialApplication
parseJSON = String
-> (Object -> Parser PartialApplication)
-> Value
-> Parser PartialApplication
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialApplication" (\Object
v -> ApplicationId -> Int -> PartialApplication
PartialApplication (ApplicationId -> Int -> PartialApplication)
-> Parser ApplicationId -> Parser (Int -> PartialApplication)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ApplicationId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id" Parser (Int -> PartialApplication)
-> Parser Int -> Parser PartialApplication
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"flags")

-- | Structure containing information about a reaction
data ReactionInfo = ReactionInfo
  { ReactionInfo -> UserId
reactionUserId    :: UserId -- ^ User who reacted
  , ReactionInfo -> Maybe GuildId
reactionGuildId   :: Maybe GuildId -- ^ Guild in which the reacted message is (if any) 
  , ReactionInfo -> ChannelId
reactionChannelId :: ChannelId -- ^ Channel in which the reacted message is
  , ReactionInfo -> MessageId
reactionMessageId :: MessageId -- ^ The reacted message
  , ReactionInfo -> Emoji
reactionEmoji     :: Emoji -- ^ The Emoji used for the reaction
  } deriving (Int -> ReactionInfo -> ShowS
[ReactionInfo] -> ShowS
ReactionInfo -> String
(Int -> ReactionInfo -> ShowS)
-> (ReactionInfo -> String)
-> ([ReactionInfo] -> ShowS)
-> Show ReactionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReactionInfo] -> ShowS
$cshowList :: [ReactionInfo] -> ShowS
show :: ReactionInfo -> String
$cshow :: ReactionInfo -> String
showsPrec :: Int -> ReactionInfo -> ShowS
$cshowsPrec :: Int -> ReactionInfo -> ShowS
Show, ReadPrec [ReactionInfo]
ReadPrec ReactionInfo
Int -> ReadS ReactionInfo
ReadS [ReactionInfo]
(Int -> ReadS ReactionInfo)
-> ReadS [ReactionInfo]
-> ReadPrec ReactionInfo
-> ReadPrec [ReactionInfo]
-> Read ReactionInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReactionInfo]
$creadListPrec :: ReadPrec [ReactionInfo]
readPrec :: ReadPrec ReactionInfo
$creadPrec :: ReadPrec ReactionInfo
readList :: ReadS [ReactionInfo]
$creadList :: ReadS [ReactionInfo]
readsPrec :: Int -> ReadS ReactionInfo
$creadsPrec :: Int -> ReadS ReactionInfo
Read, ReactionInfo -> ReactionInfo -> Bool
(ReactionInfo -> ReactionInfo -> Bool)
-> (ReactionInfo -> ReactionInfo -> Bool) -> Eq ReactionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReactionInfo -> ReactionInfo -> Bool
$c/= :: ReactionInfo -> ReactionInfo -> Bool
== :: ReactionInfo -> ReactionInfo -> Bool
$c== :: ReactionInfo -> ReactionInfo -> Bool
Eq, Eq ReactionInfo
Eq ReactionInfo
-> (ReactionInfo -> ReactionInfo -> Ordering)
-> (ReactionInfo -> ReactionInfo -> Bool)
-> (ReactionInfo -> ReactionInfo -> Bool)
-> (ReactionInfo -> ReactionInfo -> Bool)
-> (ReactionInfo -> ReactionInfo -> Bool)
-> (ReactionInfo -> ReactionInfo -> ReactionInfo)
-> (ReactionInfo -> ReactionInfo -> ReactionInfo)
-> Ord ReactionInfo
ReactionInfo -> ReactionInfo -> Bool
ReactionInfo -> ReactionInfo -> Ordering
ReactionInfo -> ReactionInfo -> ReactionInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReactionInfo -> ReactionInfo -> ReactionInfo
$cmin :: ReactionInfo -> ReactionInfo -> ReactionInfo
max :: ReactionInfo -> ReactionInfo -> ReactionInfo
$cmax :: ReactionInfo -> ReactionInfo -> ReactionInfo
>= :: ReactionInfo -> ReactionInfo -> Bool
$c>= :: ReactionInfo -> ReactionInfo -> Bool
> :: ReactionInfo -> ReactionInfo -> Bool
$c> :: ReactionInfo -> ReactionInfo -> Bool
<= :: ReactionInfo -> ReactionInfo -> Bool
$c<= :: ReactionInfo -> ReactionInfo -> Bool
< :: ReactionInfo -> ReactionInfo -> Bool
$c< :: ReactionInfo -> ReactionInfo -> Bool
compare :: ReactionInfo -> ReactionInfo -> Ordering
$ccompare :: ReactionInfo -> ReactionInfo -> Ordering
$cp1Ord :: Eq ReactionInfo
Ord)

instance FromJSON ReactionInfo where
  parseJSON :: Value -> Parser ReactionInfo
parseJSON = String
-> (Object -> Parser ReactionInfo) -> Value -> Parser ReactionInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReactionInfo" ((Object -> Parser ReactionInfo) -> Value -> Parser ReactionInfo)
-> (Object -> Parser ReactionInfo) -> Value -> Parser ReactionInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    UserId
-> Maybe GuildId -> ChannelId -> MessageId -> Emoji -> ReactionInfo
ReactionInfo (UserId
 -> Maybe GuildId
 -> ChannelId
 -> MessageId
 -> Emoji
 -> ReactionInfo)
-> Parser UserId
-> Parser
     (Maybe GuildId -> ChannelId -> MessageId -> Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"user_id"
                 Parser
  (Maybe GuildId -> ChannelId -> MessageId -> Emoji -> ReactionInfo)
-> Parser (Maybe GuildId)
-> Parser (ChannelId -> MessageId -> Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"guild_id"
                 Parser (ChannelId -> MessageId -> Emoji -> ReactionInfo)
-> Parser ChannelId -> Parser (MessageId -> Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channel_id"
                 Parser (MessageId -> Emoji -> ReactionInfo)
-> Parser MessageId -> Parser (Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MessageId
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"message_id"
                 Parser (Emoji -> ReactionInfo)
-> Parser Emoji -> Parser ReactionInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Emoji
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"emoji"

-- | Structure containing information about a reaction that has been removed
data ReactionRemoveInfo  = ReactionRemoveInfo
  { ReactionRemoveInfo -> ChannelId
reactionRemoveChannelId :: ChannelId
  , ReactionRemoveInfo -> GuildId
reactionRemoveGuildId   :: GuildId
  , ReactionRemoveInfo -> MessageId
reactionRemoveMessageId :: MessageId
  , ReactionRemoveInfo -> Emoji
reactionRemoveEmoji     :: Emoji
  } deriving (Int -> ReactionRemoveInfo -> ShowS
[ReactionRemoveInfo] -> ShowS
ReactionRemoveInfo -> String
(Int -> ReactionRemoveInfo -> ShowS)
-> (ReactionRemoveInfo -> String)
-> ([ReactionRemoveInfo] -> ShowS)
-> Show ReactionRemoveInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReactionRemoveInfo] -> ShowS
$cshowList :: [ReactionRemoveInfo] -> ShowS
show :: ReactionRemoveInfo -> String
$cshow :: ReactionRemoveInfo -> String
showsPrec :: Int -> ReactionRemoveInfo -> ShowS
$cshowsPrec :: Int -> ReactionRemoveInfo -> ShowS
Show, ReadPrec [ReactionRemoveInfo]
ReadPrec ReactionRemoveInfo
Int -> ReadS ReactionRemoveInfo
ReadS [ReactionRemoveInfo]
(Int -> ReadS ReactionRemoveInfo)
-> ReadS [ReactionRemoveInfo]
-> ReadPrec ReactionRemoveInfo
-> ReadPrec [ReactionRemoveInfo]
-> Read ReactionRemoveInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReactionRemoveInfo]
$creadListPrec :: ReadPrec [ReactionRemoveInfo]
readPrec :: ReadPrec ReactionRemoveInfo
$creadPrec :: ReadPrec ReactionRemoveInfo
readList :: ReadS [ReactionRemoveInfo]
$creadList :: ReadS [ReactionRemoveInfo]
readsPrec :: Int -> ReadS ReactionRemoveInfo
$creadsPrec :: Int -> ReadS ReactionRemoveInfo
Read, ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
(ReactionRemoveInfo -> ReactionRemoveInfo -> Bool)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> Bool)
-> Eq ReactionRemoveInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
$c/= :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
== :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
$c== :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
Eq, Eq ReactionRemoveInfo
Eq ReactionRemoveInfo
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> Ordering)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> Bool)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> Bool)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> Bool)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> Bool)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo)
-> (ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo)
-> Ord ReactionRemoveInfo
ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
ReactionRemoveInfo -> ReactionRemoveInfo -> Ordering
ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo
$cmin :: ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo
max :: ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo
$cmax :: ReactionRemoveInfo -> ReactionRemoveInfo -> ReactionRemoveInfo
>= :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
$c>= :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
> :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
$c> :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
<= :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
$c<= :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
< :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
$c< :: ReactionRemoveInfo -> ReactionRemoveInfo -> Bool
compare :: ReactionRemoveInfo -> ReactionRemoveInfo -> Ordering
$ccompare :: ReactionRemoveInfo -> ReactionRemoveInfo -> Ordering
$cp1Ord :: Eq ReactionRemoveInfo
Ord)

instance FromJSON ReactionRemoveInfo where
  parseJSON :: Value -> Parser ReactionRemoveInfo
parseJSON = String
-> (Object -> Parser ReactionRemoveInfo)
-> Value
-> Parser ReactionRemoveInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ReactionRemoveInfo" ((Object -> Parser ReactionRemoveInfo)
 -> Value -> Parser ReactionRemoveInfo)
-> (Object -> Parser ReactionRemoveInfo)
-> Value
-> Parser ReactionRemoveInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ChannelId -> GuildId -> MessageId -> Emoji -> ReactionRemoveInfo
ReactionRemoveInfo (ChannelId -> GuildId -> MessageId -> Emoji -> ReactionRemoveInfo)
-> Parser ChannelId
-> Parser (GuildId -> MessageId -> Emoji -> ReactionRemoveInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"guild_id"
                       Parser (GuildId -> MessageId -> Emoji -> ReactionRemoveInfo)
-> Parser GuildId
-> Parser (MessageId -> Emoji -> ReactionRemoveInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"channel_id"
                       Parser (MessageId -> Emoji -> ReactionRemoveInfo)
-> Parser MessageId -> Parser (Emoji -> ReactionRemoveInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MessageId
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"message_id"
                       Parser (Emoji -> ReactionRemoveInfo)
-> Parser Emoji -> Parser ReactionRemoveInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Emoji
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"emoji"

-- | Structre containing typing status information
data TypingInfo = TypingInfo
  { TypingInfo -> UserId
typingUserId    :: UserId
  , TypingInfo -> ChannelId
typingChannelId :: ChannelId
  , TypingInfo -> UTCTime
typingTimestamp :: UTCTime
  } deriving (Int -> TypingInfo -> ShowS
[TypingInfo] -> ShowS
TypingInfo -> String
(Int -> TypingInfo -> ShowS)
-> (TypingInfo -> String)
-> ([TypingInfo] -> ShowS)
-> Show TypingInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypingInfo] -> ShowS
$cshowList :: [TypingInfo] -> ShowS
show :: TypingInfo -> String
$cshow :: TypingInfo -> String
showsPrec :: Int -> TypingInfo -> ShowS
$cshowsPrec :: Int -> TypingInfo -> ShowS
Show, ReadPrec [TypingInfo]
ReadPrec TypingInfo
Int -> ReadS TypingInfo
ReadS [TypingInfo]
(Int -> ReadS TypingInfo)
-> ReadS [TypingInfo]
-> ReadPrec TypingInfo
-> ReadPrec [TypingInfo]
-> Read TypingInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypingInfo]
$creadListPrec :: ReadPrec [TypingInfo]
readPrec :: ReadPrec TypingInfo
$creadPrec :: ReadPrec TypingInfo
readList :: ReadS [TypingInfo]
$creadList :: ReadS [TypingInfo]
readsPrec :: Int -> ReadS TypingInfo
$creadsPrec :: Int -> ReadS TypingInfo
Read, TypingInfo -> TypingInfo -> Bool
(TypingInfo -> TypingInfo -> Bool)
-> (TypingInfo -> TypingInfo -> Bool) -> Eq TypingInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypingInfo -> TypingInfo -> Bool
$c/= :: TypingInfo -> TypingInfo -> Bool
== :: TypingInfo -> TypingInfo -> Bool
$c== :: TypingInfo -> TypingInfo -> Bool
Eq, Eq TypingInfo
Eq TypingInfo
-> (TypingInfo -> TypingInfo -> Ordering)
-> (TypingInfo -> TypingInfo -> Bool)
-> (TypingInfo -> TypingInfo -> Bool)
-> (TypingInfo -> TypingInfo -> Bool)
-> (TypingInfo -> TypingInfo -> Bool)
-> (TypingInfo -> TypingInfo -> TypingInfo)
-> (TypingInfo -> TypingInfo -> TypingInfo)
-> Ord TypingInfo
TypingInfo -> TypingInfo -> Bool
TypingInfo -> TypingInfo -> Ordering
TypingInfo -> TypingInfo -> TypingInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypingInfo -> TypingInfo -> TypingInfo
$cmin :: TypingInfo -> TypingInfo -> TypingInfo
max :: TypingInfo -> TypingInfo -> TypingInfo
$cmax :: TypingInfo -> TypingInfo -> TypingInfo
>= :: TypingInfo -> TypingInfo -> Bool
$c>= :: TypingInfo -> TypingInfo -> Bool
> :: TypingInfo -> TypingInfo -> Bool
$c> :: TypingInfo -> TypingInfo -> Bool
<= :: TypingInfo -> TypingInfo -> Bool
$c<= :: TypingInfo -> TypingInfo -> Bool
< :: TypingInfo -> TypingInfo -> Bool
$c< :: TypingInfo -> TypingInfo -> Bool
compare :: TypingInfo -> TypingInfo -> Ordering
$ccompare :: TypingInfo -> TypingInfo -> Ordering
$cp1Ord :: Eq TypingInfo
Ord)

instance FromJSON TypingInfo where
  parseJSON :: Value -> Parser TypingInfo
parseJSON = String
-> (Object -> Parser TypingInfo) -> Value -> Parser TypingInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TypingInfo" ((Object -> Parser TypingInfo) -> Value -> Parser TypingInfo)
-> (Object -> Parser TypingInfo) -> Value -> Parser TypingInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    do ChannelId
cid <- Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id"
       UserId
uid <- Object
o Object -> Text -> Parser UserId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_id"
       POSIXTime
posix <- Object
o Object -> Text -> Parser POSIXTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"timestamp"
       let utc :: UTCTime
utc = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posix
       TypingInfo -> Parser TypingInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> ChannelId -> UTCTime -> TypingInfo
TypingInfo UserId
uid ChannelId
cid UTCTime
utc)



-- | Convert ToJSON value to FromJSON value
reparse :: (ToJSON a, FromJSON b) => a -> Parser b
reparse :: a -> Parser b
reparse a
val = case (Value -> Parser b) -> Value -> Either String b
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Either String b) -> Value -> Either String b
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
val of
                Left String
r -> String -> Parser b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
r
                Right b
b -> b -> Parser b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b

-- | Parse an event from name and JSON data
eventParse :: T.Text -> Object -> Parser EventInternalParse
eventParse :: Text -> Object -> Parser EventInternalParse
eventParse Text
t Object
o = case Text
t of
    Text
"READY"                     -> Int
-> User
-> [Channel]
-> [GuildUnavailable]
-> Text
-> Maybe Shard
-> PartialApplication
-> EventInternalParse
InternalReady (Int
 -> User
 -> [Channel]
 -> [GuildUnavailable]
 -> Text
 -> Maybe Shard
 -> PartialApplication
 -> EventInternalParse)
-> Parser Int
-> Parser
     (User
      -> [Channel]
      -> [GuildUnavailable]
      -> Text
      -> Maybe Shard
      -> PartialApplication
      -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"v"
                                         Parser
  (User
   -> [Channel]
   -> [GuildUnavailable]
   -> Text
   -> Maybe Shard
   -> PartialApplication
   -> EventInternalParse)
-> Parser User
-> Parser
     ([Channel]
      -> [GuildUnavailable]
      -> Text
      -> Maybe Shard
      -> PartialApplication
      -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
                                         Parser
  ([Channel]
   -> [GuildUnavailable]
   -> Text
   -> Maybe Shard
   -> PartialApplication
   -> EventInternalParse)
-> Parser [Channel]
-> Parser
     ([GuildUnavailable]
      -> Text -> Maybe Shard -> PartialApplication -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Channel]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"private_channels"
                                         Parser
  ([GuildUnavailable]
   -> Text -> Maybe Shard -> PartialApplication -> EventInternalParse)
-> Parser [GuildUnavailable]
-> Parser
     (Text -> Maybe Shard -> PartialApplication -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [GuildUnavailable]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guilds"
                                         Parser
  (Text -> Maybe Shard -> PartialApplication -> EventInternalParse)
-> Parser Text
-> Parser (Maybe Shard -> PartialApplication -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"session_id"
                                         Parser (Maybe Shard -> PartialApplication -> EventInternalParse)
-> Parser (Maybe Shard)
-> Parser (PartialApplication -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Shard)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"shard"
                                         Parser (PartialApplication -> EventInternalParse)
-> Parser PartialApplication -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser PartialApplication
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"application"
    Text
"RESUMED"                   -> [Text] -> EventInternalParse
InternalResumed ([Text] -> EventInternalParse)
-> Parser [Text] -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"_trace"
    Text
"CHANNEL_CREATE"            -> Channel -> EventInternalParse
InternalChannelCreate             (Channel -> EventInternalParse)
-> Parser Channel -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Channel
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"CHANNEL_UPDATE"            -> Channel -> EventInternalParse
InternalChannelUpdate             (Channel -> EventInternalParse)
-> Parser Channel -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Channel
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"CHANNEL_DELETE"            -> Channel -> EventInternalParse
InternalChannelDelete             (Channel -> EventInternalParse)
-> Parser Channel -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Channel
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_CREATE"             -> Channel -> EventInternalParse
InternalThreadCreate              (Channel -> EventInternalParse)
-> Parser Channel -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Channel
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_UPDATE"             -> Channel -> EventInternalParse
InternalThreadUpdate              (Channel -> EventInternalParse)
-> Parser Channel -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Channel
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_DELETE"             -> Channel -> EventInternalParse
InternalThreadDelete              (Channel -> EventInternalParse)
-> Parser Channel -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Channel
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_LIST_SYNC"          -> ThreadListSyncFields -> EventInternalParse
InternalThreadListSync            (ThreadListSyncFields -> EventInternalParse)
-> Parser ThreadListSyncFields -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ThreadListSyncFields
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_MEMBERS_UPDATE"     -> ThreadMembersUpdateFields -> EventInternalParse
InternalThreadMembersUpdate       (ThreadMembersUpdateFields -> EventInternalParse)
-> Parser ThreadMembersUpdateFields -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ThreadMembersUpdateFields
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"CHANNEL_PINS_UPDATE"       -> do ChannelId
id <- Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id"
                                      Maybe String
stamp <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"last_pin_timestamp"
                                      let utc :: Maybe UTCTime
utc = Maybe String
stamp Maybe String -> (String -> Maybe UTCTime) -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe UTCTime
parseISO8601
                                      EventInternalParse -> Parser EventInternalParse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelId -> Maybe UTCTime -> EventInternalParse
InternalChannelPinsUpdate ChannelId
id Maybe UTCTime
utc)
    Text
"GUILD_CREATE"              -> Guild -> EventInternalParse
InternalGuildCreate               (Guild -> EventInternalParse)
-> Parser Guild -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Guild
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_UPDATE"              -> Guild -> EventInternalParse
InternalGuildUpdate               (Guild -> EventInternalParse)
-> Parser Guild -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Guild
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_DELETE"              -> GuildUnavailable -> EventInternalParse
InternalGuildDelete               (GuildUnavailable -> EventInternalParse)
-> Parser GuildUnavailable -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser GuildUnavailable
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_BAN_ADD"             -> GuildId -> User -> EventInternalParse
InternalGuildBanAdd    (GuildId -> User -> EventInternalParse)
-> Parser GuildId -> Parser (User -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (User -> EventInternalParse)
-> Parser User -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
    Text
"GUILD_BAN_REMOVE"          -> GuildId -> User -> EventInternalParse
InternalGuildBanRemove (GuildId -> User -> EventInternalParse)
-> Parser GuildId -> Parser (User -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (User -> EventInternalParse)
-> Parser User -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
    Text
"GUILD_EMOJI_UPDATE"        -> GuildId -> [Emoji] -> EventInternalParse
InternalGuildEmojiUpdate (GuildId -> [Emoji] -> EventInternalParse)
-> Parser GuildId -> Parser ([Emoji] -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser ([Emoji] -> EventInternalParse)
-> Parser [Emoji] -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Emoji]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"emojis"
    Text
"GUILD_INTEGRATIONS_UPDATE" -> GuildId -> EventInternalParse
InternalGuildIntegrationsUpdate   (GuildId -> EventInternalParse)
-> Parser GuildId -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id"
    Text
"GUILD_MEMBER_ADD"          -> GuildId -> GuildMember -> EventInternalParse
InternalGuildMemberAdd (GuildId -> GuildMember -> EventInternalParse)
-> Parser GuildId -> Parser (GuildMember -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (GuildMember -> EventInternalParse)
-> Parser GuildMember -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser GuildMember
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_MEMBER_REMOVE"       -> GuildId -> User -> EventInternalParse
InternalGuildMemberRemove (GuildId -> User -> EventInternalParse)
-> Parser GuildId -> Parser (User -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (User -> EventInternalParse)
-> Parser User -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
    Text
"GUILD_MEMBER_UPDATE"       -> GuildId -> [RoleId] -> User -> Maybe Text -> EventInternalParse
InternalGuildMemberUpdate (GuildId -> [RoleId] -> User -> Maybe Text -> EventInternalParse)
-> Parser GuildId
-> Parser ([RoleId] -> User -> Maybe Text -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id"
                                                             Parser ([RoleId] -> User -> Maybe Text -> EventInternalParse)
-> Parser [RoleId]
-> Parser (User -> Maybe Text -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [RoleId]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"roles"
                                                             Parser (User -> Maybe Text -> EventInternalParse)
-> Parser User -> Parser (Maybe Text -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser User
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user"
                                                             Parser (Maybe Text -> EventInternalParse)
-> Parser (Maybe Text) -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"nick"
    Text
"GUILD_MEMBERS_CHUNK"       -> GuildId -> [GuildMember] -> EventInternalParse
InternalGuildMemberChunk (GuildId -> [GuildMember] -> EventInternalParse)
-> Parser GuildId -> Parser ([GuildMember] -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser ([GuildMember] -> EventInternalParse)
-> Parser [GuildMember] -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [GuildMember]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"members"
    Text
"GUILD_ROLE_CREATE"         -> GuildId -> Role -> EventInternalParse
InternalGuildRoleCreate  (GuildId -> Role -> EventInternalParse)
-> Parser GuildId -> Parser (Role -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (Role -> EventInternalParse)
-> Parser Role -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Role
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"role"
    Text
"GUILD_ROLE_UPDATE"         -> GuildId -> Role -> EventInternalParse
InternalGuildRoleUpdate  (GuildId -> Role -> EventInternalParse)
-> Parser GuildId -> Parser (Role -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (Role -> EventInternalParse)
-> Parser Role -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Role
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"role"
    Text
"GUILD_ROLE_DELETE"         -> GuildId -> RoleId -> EventInternalParse
InternalGuildRoleDelete  (GuildId -> RoleId -> EventInternalParse)
-> Parser GuildId -> Parser (RoleId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser GuildId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"guild_id" Parser (RoleId -> EventInternalParse)
-> Parser RoleId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser RoleId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"role_id"
    Text
"MESSAGE_CREATE"            -> Message -> EventInternalParse
InternalMessageCreate     (Message -> EventInternalParse)
-> Parser Message -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Message
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"MESSAGE_UPDATE"            -> ChannelId -> MessageId -> EventInternalParse
InternalMessageUpdate     (ChannelId -> MessageId -> EventInternalParse)
-> Parser ChannelId -> Parser (MessageId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id" Parser (MessageId -> EventInternalParse)
-> Parser MessageId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MessageId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Text
"MESSAGE_DELETE"            -> ChannelId -> MessageId -> EventInternalParse
InternalMessageDelete     (ChannelId -> MessageId -> EventInternalParse)
-> Parser ChannelId -> Parser (MessageId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id" Parser (MessageId -> EventInternalParse)
-> Parser MessageId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MessageId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Text
"MESSAGE_DELETE_BULK"       -> ChannelId -> [MessageId] -> EventInternalParse
InternalMessageDeleteBulk (ChannelId -> [MessageId] -> EventInternalParse)
-> Parser ChannelId -> Parser ([MessageId] -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id" Parser ([MessageId] -> EventInternalParse)
-> Parser [MessageId] -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [MessageId]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ids"
    Text
"MESSAGE_REACTION_ADD"      -> ReactionInfo -> EventInternalParse
InternalMessageReactionAdd (ReactionInfo -> EventInternalParse)
-> Parser ReactionInfo -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ReactionInfo
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"MESSAGE_REACTION_REMOVE"   -> ReactionInfo -> EventInternalParse
InternalMessageReactionRemove (ReactionInfo -> EventInternalParse)
-> Parser ReactionInfo -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ReactionInfo
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"MESSAGE_REACTION_REMOVE_ALL" -> ChannelId -> MessageId -> EventInternalParse
InternalMessageReactionRemoveAll (ChannelId -> MessageId -> EventInternalParse)
-> Parser ChannelId -> Parser (MessageId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ChannelId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channel_id"
                                                                      Parser (MessageId -> EventInternalParse)
-> Parser MessageId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser MessageId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"message_id"
    Text
"MESSAGE_REACTION_REMOVE_EMOJI" -> ReactionRemoveInfo -> EventInternalParse
InternalMessageReactionRemoveEmoji (ReactionRemoveInfo -> EventInternalParse)
-> Parser ReactionRemoveInfo -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ReactionRemoveInfo
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"PRESENCE_UPDATE"           -> PresenceInfo -> EventInternalParse
InternalPresenceUpdate            (PresenceInfo -> EventInternalParse)
-> Parser PresenceInfo -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser PresenceInfo
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"TYPING_START"              -> TypingInfo -> EventInternalParse
InternalTypingStart               (TypingInfo -> EventInternalParse)
-> Parser TypingInfo -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser TypingInfo
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"USER_UPDATE"               -> User -> EventInternalParse
InternalUserUpdate                (User -> EventInternalParse)
-> Parser User -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser User
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
 -- "VOICE_STATE_UPDATE"        -> InternalVoiceStateUpdate          <$> reparse o
 -- "VOICE_SERVER_UPDATE"       -> InternalVoiceServerUpdate         <$> reparse o
    Text
"INTERACTION_CREATE"        -> Interaction -> EventInternalParse
InternalInteractionCreate         (Interaction -> EventInternalParse)
-> Parser Interaction -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Interaction
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
_other_event                -> Text -> Object -> EventInternalParse
InternalUnknownEvent Text
t            (Object -> EventInternalParse)
-> Parser Object -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Object
forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o