{-# 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     ( Role, GuildInfo, GuildUnavailable, Guild )
import Discord.Internal.Types.User (User, GuildMember)
import Discord.Internal.Types.Interactions (InternalInteraction, Interaction)
import Discord.Internal.Types.Components (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
  | ChannelPinsUpdate       ChannelId (Maybe UTCTime)
  | GuildCreate             Guild GuildInfo
  | GuildUpdate             Guild
  | GuildDelete             GuildUnavailable
  | GuildBanAdd             GuildId User
  | GuildBanRemove          GuildId User
  | GuildEmojiUpdate        GuildId [Emoji]
  | GuildIntegrationsUpdate GuildId
  | GuildMemberAdd          GuildId GuildMember
  | GuildMemberRemove       GuildId User
  | GuildMemberUpdate       GuildId [RoleId] User (Maybe T.Text)
  | GuildMemberChunk        GuildId [GuildMember]
  | GuildRoleCreate         GuildId Role
  | GuildRoleUpdate         GuildId Role
  | GuildRoleDelete         GuildId RoleId
  | MessageCreate           Message
  | MessageUpdate           ChannelId MessageId
  | MessageDelete           ChannelId MessageId
  | MessageDeleteBulk       ChannelId [MessageId]
  | MessageReactionAdd      ReactionInfo
  | MessageReactionRemove   ReactionInfo
  | MessageReactionRemoveAll ChannelId MessageId
  | 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, ReadPrec [Event]
ReadPrec Event
Int -> ReadS Event
ReadS [Event]
(Int -> ReadS Event)
-> ReadS [Event]
-> ReadPrec Event
-> ReadPrec [Event]
-> Read Event
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Event]
$creadListPrec :: ReadPrec [Event]
readPrec :: ReadPrec Event
$creadPrec :: ReadPrec Event
readList :: ReadS [Event]
$creadList :: ReadS [Event]
readsPrec :: Int -> ReadS Event
$creadsPrec :: Int -> ReadS Event
Read, 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
  | InternalChannelPinsUpdate       ChannelId (Maybe UTCTime)
  | InternalGuildCreate             Guild GuildInfo
  | 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       InternalInteraction
  -- | 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, 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, 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)

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 PresenceInfo = PresenceInfo
  { PresenceInfo -> ApplicationId
presenceUserId  :: UserId
  , PresenceInfo -> [ApplicationId]
presenceRoles   :: [RoleId]
  -- , presenceGame :: Maybe Activity
  , PresenceInfo -> ApplicationId
presenceGuildId :: GuildId
  , PresenceInfo -> Text
presenceStatus  :: T.Text
  } deriving (Int -> PresenceInfo -> ShowS
[PresenceInfo] -> ShowS
PresenceInfo -> String
(Int -> PresenceInfo -> ShowS)
-> (PresenceInfo -> String)
-> ([PresenceInfo] -> ShowS)
-> Show PresenceInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PresenceInfo] -> ShowS
$cshowList :: [PresenceInfo] -> ShowS
show :: PresenceInfo -> String
$cshow :: PresenceInfo -> String
showsPrec :: Int -> PresenceInfo -> ShowS
$cshowsPrec :: Int -> PresenceInfo -> ShowS
Show, ReadPrec [PresenceInfo]
ReadPrec PresenceInfo
Int -> ReadS PresenceInfo
ReadS [PresenceInfo]
(Int -> ReadS PresenceInfo)
-> ReadS [PresenceInfo]
-> ReadPrec PresenceInfo
-> ReadPrec [PresenceInfo]
-> Read PresenceInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PresenceInfo]
$creadListPrec :: ReadPrec [PresenceInfo]
readPrec :: ReadPrec PresenceInfo
$creadPrec :: ReadPrec PresenceInfo
readList :: ReadS [PresenceInfo]
$creadList :: ReadS [PresenceInfo]
readsPrec :: Int -> ReadS PresenceInfo
$creadsPrec :: Int -> ReadS PresenceInfo
Read, PresenceInfo -> PresenceInfo -> Bool
(PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool) -> Eq PresenceInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PresenceInfo -> PresenceInfo -> Bool
$c/= :: PresenceInfo -> PresenceInfo -> Bool
== :: PresenceInfo -> PresenceInfo -> Bool
$c== :: PresenceInfo -> PresenceInfo -> Bool
Eq, Eq PresenceInfo
Eq PresenceInfo
-> (PresenceInfo -> PresenceInfo -> Ordering)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> Bool)
-> (PresenceInfo -> PresenceInfo -> PresenceInfo)
-> (PresenceInfo -> PresenceInfo -> PresenceInfo)
-> Ord PresenceInfo
PresenceInfo -> PresenceInfo -> Bool
PresenceInfo -> PresenceInfo -> Ordering
PresenceInfo -> PresenceInfo -> PresenceInfo
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 :: PresenceInfo -> PresenceInfo -> PresenceInfo
$cmin :: PresenceInfo -> PresenceInfo -> PresenceInfo
max :: PresenceInfo -> PresenceInfo -> PresenceInfo
$cmax :: PresenceInfo -> PresenceInfo -> PresenceInfo
>= :: PresenceInfo -> PresenceInfo -> Bool
$c>= :: PresenceInfo -> PresenceInfo -> Bool
> :: PresenceInfo -> PresenceInfo -> Bool
$c> :: PresenceInfo -> PresenceInfo -> Bool
<= :: PresenceInfo -> PresenceInfo -> Bool
$c<= :: PresenceInfo -> PresenceInfo -> Bool
< :: PresenceInfo -> PresenceInfo -> Bool
$c< :: PresenceInfo -> PresenceInfo -> Bool
compare :: PresenceInfo -> PresenceInfo -> Ordering
$ccompare :: PresenceInfo -> PresenceInfo -> Ordering
$cp1Ord :: Eq PresenceInfo
Ord)

instance FromJSON PresenceInfo where
  parseJSON :: Value -> Parser PresenceInfo
parseJSON = String
-> (Object -> Parser PresenceInfo) -> Value -> Parser PresenceInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PresenceInfo" ((Object -> Parser PresenceInfo) -> Value -> Parser PresenceInfo)
-> (Object -> Parser PresenceInfo) -> Value -> Parser PresenceInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ApplicationId
-> [ApplicationId] -> ApplicationId -> Text -> PresenceInfo
PresenceInfo (ApplicationId
 -> [ApplicationId] -> ApplicationId -> Text -> PresenceInfo)
-> Parser ApplicationId
-> Parser
     ([ApplicationId] -> ApplicationId -> Text -> PresenceInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user" Parser Object
-> (Object -> Parser ApplicationId) -> Parser ApplicationId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"))
                 Parser ([ApplicationId] -> ApplicationId -> Text -> PresenceInfo)
-> Parser [ApplicationId]
-> Parser (ApplicationId -> Text -> PresenceInfo)
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"
              -- <*> o .: "game"
                 Parser (ApplicationId -> Text -> PresenceInfo)
-> Parser ApplicationId -> Parser (Text -> PresenceInfo)
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
"guild_id"
                 Parser (Text -> PresenceInfo) -> Parser Text -> Parser PresenceInfo
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
"status"

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
"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 -> GuildInfo -> EventInternalParse
InternalGuildCreate               (Guild -> GuildInfo -> EventInternalParse)
-> Parser Guild -> Parser (GuildInfo -> 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 Parser (GuildInfo -> EventInternalParse)
-> Parser GuildInfo -> Parser EventInternalParse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser GuildInfo
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"        -> InternalInteraction -> EventInternalParse
InternalInteractionCreate         (InternalInteraction -> EventInternalParse)
-> Parser InternalInteraction -> Parser EventInternalParse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser InternalInteraction
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