{-# 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 =
    Ready                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication
  | Resumed                    [T.Text]
  | ChannelCreate              Channel
  | ChannelUpdate              Channel
  | ChannelDelete              Channel
  | ThreadCreate               Channel
  | ThreadUpdate               Channel
  | ThreadDelete               Channel
  | ThreadListSync             ThreadListSyncFields 
  | ThreadMembersUpdate        ThreadMembersUpdateFields 
  | ChannelPinsUpdate          ChannelId (Maybe UTCTime)
  | GuildCreate                Guild
  | 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
  | MessageReactionRemoveEmoji ReactionRemoveInfo
  | PresenceUpdate             PresenceInfo
  | TypingStart                TypingInfo
  | UserUpdate                 User
  | InteractionCreate          Interaction
  -- | VoiceStateUpdate
  -- | VoiceServerUpdate
  | 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)

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)

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 -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser (Int -> PartialApplication)
-> Parser Int -> Parser PartialApplication
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
"flags")

data ReactionInfo = ReactionInfo
  { ReactionInfo -> ApplicationId
reactionUserId    :: UserId
  , ReactionInfo -> Maybe ApplicationId
reactionGuildId   :: Maybe GuildId
  , ReactionInfo -> ApplicationId
reactionChannelId :: ChannelId
  , ReactionInfo -> ApplicationId
reactionMessageId :: MessageId
  , ReactionInfo -> Emoji
reactionEmoji     :: Emoji
  } 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 ->
    ApplicationId
-> Maybe ApplicationId
-> ApplicationId
-> ApplicationId
-> Emoji
-> ReactionInfo
ReactionInfo (ApplicationId
 -> Maybe ApplicationId
 -> ApplicationId
 -> ApplicationId
 -> Emoji
 -> ReactionInfo)
-> Parser ApplicationId
-> Parser
     (Maybe ApplicationId
      -> ApplicationId -> ApplicationId -> Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"user_id"
                 Parser
  (Maybe ApplicationId
   -> ApplicationId -> ApplicationId -> Emoji -> ReactionInfo)
-> Parser (Maybe ApplicationId)
-> Parser (ApplicationId -> ApplicationId -> Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ApplicationId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
                 Parser (ApplicationId -> ApplicationId -> Emoji -> ReactionInfo)
-> Parser ApplicationId
-> Parser (ApplicationId -> Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"channel_id"
                 Parser (ApplicationId -> Emoji -> ReactionInfo)
-> Parser ApplicationId -> Parser (Emoji -> ReactionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"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 -> Key -> Parser Emoji
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"emoji"

data ReactionRemoveInfo  = ReactionRemoveInfo
  { ReactionRemoveInfo -> ApplicationId
reactionRemoveChannelId :: ChannelId
  , ReactionRemoveInfo -> ApplicationId
reactionRemoveGuildId   :: GuildId
  , ReactionRemoveInfo -> ApplicationId
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 ->
    ApplicationId
-> ApplicationId -> ApplicationId -> Emoji -> ReactionRemoveInfo
ReactionRemoveInfo (ApplicationId
 -> ApplicationId -> ApplicationId -> Emoji -> ReactionRemoveInfo)
-> Parser ApplicationId
-> Parser
     (ApplicationId -> ApplicationId -> Emoji -> ReactionRemoveInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"guild_id"
                       Parser
  (ApplicationId -> ApplicationId -> Emoji -> ReactionRemoveInfo)
-> Parser ApplicationId
-> Parser (ApplicationId -> Emoji -> ReactionRemoveInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"channel_id"
                       Parser (ApplicationId -> Emoji -> ReactionRemoveInfo)
-> Parser ApplicationId -> Parser (Emoji -> ReactionRemoveInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"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 -> Key -> Parser Emoji
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"emoji"

data TypingInfo = TypingInfo
  { TypingInfo -> ApplicationId
typingUserId    :: UserId
  , TypingInfo -> ApplicationId
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 ApplicationId
cid <- Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id"
       ApplicationId
uid <- Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
       POSIXTime
posix <- Object
o Object -> Key -> Parser POSIXTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
       let utc :: UTCTime
utc = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posix
       TypingInfo -> Parser TypingInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApplicationId -> ApplicationId -> UTCTime -> TypingInfo
TypingInfo ApplicationId
uid ApplicationId
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

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 -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser [Channel]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser [GuildUnavailable]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser (Maybe Shard)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shard"
                                         Parser (PartialApplication -> EventInternalParse)
-> Parser PartialApplication -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser PartialApplication
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_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 ApplicationId
id <- Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id"
                                      Maybe String
stamp <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"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 (ApplicationId -> Maybe UTCTime -> EventInternalParse
InternalChannelPinsUpdate ApplicationId
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"             -> ApplicationId -> User -> EventInternalParse
InternalGuildBanAdd    (ApplicationId -> User -> EventInternalParse)
-> Parser ApplicationId -> Parser (User -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"GUILD_BAN_REMOVE"          -> ApplicationId -> User -> EventInternalParse
InternalGuildBanRemove (ApplicationId -> User -> EventInternalParse)
-> Parser ApplicationId -> Parser (User -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"GUILD_EMOJI_UPDATE"        -> ApplicationId -> [Emoji] -> EventInternalParse
InternalGuildEmojiUpdate (ApplicationId -> [Emoji] -> EventInternalParse)
-> Parser ApplicationId -> Parser ([Emoji] -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser [Emoji]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emojis"
    Text
"GUILD_INTEGRATIONS_UPDATE" -> ApplicationId -> EventInternalParse
InternalGuildIntegrationsUpdate   (ApplicationId -> EventInternalParse)
-> Parser ApplicationId -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
    Text
"GUILD_MEMBER_ADD"          -> ApplicationId -> GuildMember -> EventInternalParse
InternalGuildMemberAdd (ApplicationId -> GuildMember -> EventInternalParse)
-> Parser ApplicationId
-> Parser (GuildMember -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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"       -> ApplicationId -> User -> EventInternalParse
InternalGuildMemberRemove (ApplicationId -> User -> EventInternalParse)
-> Parser ApplicationId -> Parser (User -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"GUILD_MEMBER_UPDATE"       -> ApplicationId
-> [ApplicationId] -> User -> Maybe Text -> EventInternalParse
InternalGuildMemberUpdate (ApplicationId
 -> [ApplicationId] -> User -> Maybe Text -> EventInternalParse)
-> Parser ApplicationId
-> Parser
     ([ApplicationId] -> User -> Maybe Text -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
                                                             Parser
  ([ApplicationId] -> User -> Maybe Text -> EventInternalParse)
-> Parser [ApplicationId]
-> Parser (User -> Maybe Text -> EventInternalParse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ApplicationId]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser User
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nick"
    Text
"GUILD_MEMBERS_CHUNK"       -> ApplicationId -> [GuildMember] -> EventInternalParse
InternalGuildMemberChunk (ApplicationId -> [GuildMember] -> EventInternalParse)
-> Parser ApplicationId
-> Parser ([GuildMember] -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser [GuildMember]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members"
    Text
"GUILD_ROLE_CREATE"         -> ApplicationId -> Role -> EventInternalParse
InternalGuildRoleCreate  (ApplicationId -> Role -> EventInternalParse)
-> Parser ApplicationId -> Parser (Role -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser Role
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
    Text
"GUILD_ROLE_UPDATE"         -> ApplicationId -> Role -> EventInternalParse
InternalGuildRoleUpdate  (ApplicationId -> Role -> EventInternalParse)
-> Parser ApplicationId -> Parser (Role -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser Role
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
    Text
"GUILD_ROLE_DELETE"         -> ApplicationId -> ApplicationId -> EventInternalParse
InternalGuildRoleDelete  (ApplicationId -> ApplicationId -> EventInternalParse)
-> Parser ApplicationId
-> Parser (ApplicationId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" Parser (ApplicationId -> EventInternalParse)
-> Parser ApplicationId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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"            -> ApplicationId -> ApplicationId -> EventInternalParse
InternalMessageUpdate     (ApplicationId -> ApplicationId -> EventInternalParse)
-> Parser ApplicationId
-> Parser (ApplicationId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id" Parser (ApplicationId -> EventInternalParse)
-> Parser ApplicationId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
"MESSAGE_DELETE"            -> ApplicationId -> ApplicationId -> EventInternalParse
InternalMessageDelete     (ApplicationId -> ApplicationId -> EventInternalParse)
-> Parser ApplicationId
-> Parser (ApplicationId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id" Parser (ApplicationId -> EventInternalParse)
-> Parser ApplicationId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
"MESSAGE_DELETE_BULK"       -> ApplicationId -> [ApplicationId] -> EventInternalParse
InternalMessageDeleteBulk (ApplicationId -> [ApplicationId] -> EventInternalParse)
-> Parser ApplicationId
-> Parser ([ApplicationId] -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id" Parser ([ApplicationId] -> EventInternalParse)
-> Parser [ApplicationId] -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ApplicationId]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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" -> ApplicationId -> ApplicationId -> EventInternalParse
InternalMessageReactionRemoveAll (ApplicationId -> ApplicationId -> EventInternalParse)
-> Parser ApplicationId
-> Parser (ApplicationId -> EventInternalParse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id"
                                                                      Parser (ApplicationId -> EventInternalParse)
-> Parser ApplicationId -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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