{-# 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 Network.Socket (HostName)

import Data.Aeson
import Data.Aeson.Types
import qualified Data.Text as T

import Discord.Internal.Types.Prelude
import Discord.Internal.Types.Channel
import Discord.Internal.Types.Guild
import Discord.Internal.Types.User (User, GuildMember)
import Discord.Internal.Types.Interactions (Interaction)
import Discord.Internal.Types.Emoji (Emoji)


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

-- | Internal Event representation. Each matches to the corresponding constructor of `Event`.
--
-- An application should never have to use those directly
data EventInternalParse =
    InternalReady                      Int User [GuildUnavailable] T.Text HostName (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
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
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]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EventInternalParse]
$creadListPrec :: ReadPrec [EventInternalParse]
readPrec :: ReadPrec EventInternalParse
$creadPrec :: ReadPrec EventInternalParse
readList :: ReadS [EventInternalParse]
$creadList :: ReadS [EventInternalParse]
readsPrec :: Int -> ReadS EventInternalParse
$creadsPrec :: Int -> ReadS EventInternalParse
Read)

-- | Structure containing partial information about an Application
data PartialApplication = PartialApplication
  { PartialApplication -> ApplicationId
partialApplicationID :: ApplicationId
  , PartialApplication -> Int
partialApplicationFlags :: Int
  } deriving (Int -> PartialApplication -> ShowS
[PartialApplication] -> ShowS
PartialApplication -> String
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
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]
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialApplication" (\Object
v -> ApplicationId -> Int -> PartialApplication
PartialApplication forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"flags")

-- | Structure containing information about a reaction
data ReactionInfo = ReactionInfo
  { ReactionInfo -> UserId
reactionUserId    :: UserId -- ^ User who reacted
  , ReactionInfo -> Maybe GuildId
reactionGuildId   :: Maybe GuildId -- ^ Guild in which the reacted message is (if any) 
  , ReactionInfo -> ChannelId
reactionChannelId :: ChannelId -- ^ Channel in which the reacted message is
  , ReactionInfo -> MessageId
reactionMessageId :: MessageId -- ^ The reacted message
  , ReactionInfo -> Emoji
reactionEmoji     :: Emoji -- ^ The Emoji used for the reaction
  } deriving (Int -> ReactionInfo -> ShowS
[ReactionInfo] -> ShowS
ReactionInfo -> String
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]
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
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
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
Ord)

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

-- | Structure containing information about a reaction that has been removed
data ReactionRemoveInfo  = ReactionRemoveInfo
  { ReactionRemoveInfo -> ChannelId
reactionRemoveChannelId :: ChannelId
  , ReactionRemoveInfo -> GuildId
reactionRemoveGuildId   :: GuildId
  , ReactionRemoveInfo -> MessageId
reactionRemoveMessageId :: MessageId
  , ReactionRemoveInfo -> Emoji
reactionRemoveEmoji     :: Emoji
  } deriving (Int -> ReactionRemoveInfo -> ShowS
[ReactionRemoveInfo] -> ShowS
ReactionRemoveInfo -> String
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]
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
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
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
Ord)

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

-- | Structre containing typing status information
data TypingInfo = TypingInfo
  { TypingInfo -> UserId
typingUserId    :: UserId
  , TypingInfo -> ChannelId
typingChannelId :: ChannelId
  , TypingInfo -> UTCTime
typingTimestamp :: UTCTime
  } deriving (Int -> TypingInfo -> ShowS
[TypingInfo] -> ShowS
TypingInfo -> String
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]
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
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
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
Ord)

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



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

-- | Remove the "wss://" and the trailing slash in a gateway URL, thereby returning
-- the hostname portion of the URL that we can connect to.
extractHostname :: String -> HostName
extractHostname :: ShowS
extractHostname (Char
'w':Char
's':Char
's':Char
':':Char
'/':Char
'/':String
rest) = ShowS
extractHostname String
rest
extractHostname (Char
'/':[]) = []
extractHostname (Char
a:String
b) = Char
aforall a. a -> [a] -> [a]
:(ShowS
extractHostname String
b)
extractHostname [] = []

-- | Parse an event from name and JSON data
eventParse :: T.Text -> Object -> Parser EventInternalParse
eventParse :: Text -> Object -> Parser EventInternalParse
eventParse Text
t Object
o = case Text
t of
    Text
"READY"                     -> Int
-> User
-> [GuildUnavailable]
-> Text
-> String
-> Maybe Shard
-> PartialApplication
-> EventInternalParse
InternalReady forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"v"
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guilds"
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"session_id"
                                          -- Discord can send us the resume gateway URL prefixed with "wss://",
                                          -- and suffixed with a trailing slash. This is not a valid HostName,
                                          -- so remove them both if they exist.
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ShowS
extractHostname forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resume_gateway_url")
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shard"
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application"
    Text
"RESUMED"                   -> [Text] -> EventInternalParse
InternalResumed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_trace"
    Text
"CHANNEL_CREATE"            -> Channel -> EventInternalParse
InternalChannelCreate             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"CHANNEL_UPDATE"            -> Channel -> EventInternalParse
InternalChannelUpdate             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"CHANNEL_DELETE"            -> Channel -> EventInternalParse
InternalChannelDelete             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_CREATE"             -> Channel -> EventInternalParse
InternalThreadCreate              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_UPDATE"             -> Channel -> EventInternalParse
InternalThreadUpdate              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_DELETE"             -> Channel -> EventInternalParse
InternalThreadDelete              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_LIST_SYNC"          -> ThreadListSyncFields -> EventInternalParse
InternalThreadListSync            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"THREAD_MEMBERS_UPDATE"     -> ThreadMembersUpdateFields -> EventInternalParse
InternalThreadMembersUpdate       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"CHANNEL_PINS_UPDATE"       -> do ChannelId
id <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id"
                                      Maybe String
stamp <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_pin_timestamp"
                                      let utc :: Maybe UTCTime
utc = Maybe String
stamp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe UTCTime
parseISO8601
                                      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelId -> Maybe UTCTime -> EventInternalParse
InternalChannelPinsUpdate ChannelId
id Maybe UTCTime
utc)
    Text
"GUILD_CREATE"              -> Guild -> EventInternalParse
InternalGuildCreate               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_UPDATE"              -> Guild -> EventInternalParse
InternalGuildUpdate               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_DELETE"              -> GuildUnavailable -> EventInternalParse
InternalGuildDelete               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_BAN_ADD"             -> GuildId -> User -> EventInternalParse
InternalGuildBanAdd    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"GUILD_BAN_REMOVE"          -> GuildId -> User -> EventInternalParse
InternalGuildBanRemove forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"GUILD_EMOJI_UPDATE"        -> GuildId -> [Emoji] -> EventInternalParse
InternalGuildEmojiUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"emojis"
    Text
"GUILD_INTEGRATIONS_UPDATE" -> GuildId -> EventInternalParse
InternalGuildIntegrationsUpdate   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
    Text
"GUILD_MEMBER_ADD"          -> GuildId -> GuildMember -> EventInternalParse
InternalGuildMemberAdd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"GUILD_MEMBER_REMOVE"       -> GuildId -> User -> EventInternalParse
InternalGuildMemberRemove forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
    Text
"GUILD_MEMBER_UPDATE"       -> GuildId -> [RoleId] -> User -> Maybe Text -> EventInternalParse
InternalGuildMemberUpdate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
                                                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"roles"
                                                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
                                                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nick"
    Text
"GUILD_MEMBERS_CHUNK"       -> GuildId -> [GuildMember] -> EventInternalParse
InternalGuildMemberChunk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members"
    Text
"GUILD_ROLE_CREATE"         -> GuildId -> Role -> EventInternalParse
InternalGuildRoleCreate  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
    Text
"GUILD_ROLE_UPDATE"         -> GuildId -> Role -> EventInternalParse
InternalGuildRoleUpdate  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
    Text
"GUILD_ROLE_DELETE"         -> GuildId -> RoleId -> EventInternalParse
InternalGuildRoleDelete  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role_id"
    Text
"MESSAGE_CREATE"            -> Message -> EventInternalParse
InternalMessageCreate     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"MESSAGE_UPDATE"            -> ChannelId -> MessageId -> EventInternalParse
InternalMessageUpdate     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
"MESSAGE_DELETE"            -> ChannelId -> MessageId -> EventInternalParse
InternalMessageDelete     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
"MESSAGE_DELETE_BULK"       -> ChannelId -> [MessageId] -> EventInternalParse
InternalMessageDeleteBulk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ids"
    Text
"MESSAGE_REACTION_ADD"      -> ReactionInfo -> EventInternalParse
InternalMessageReactionAdd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"MESSAGE_REACTION_REMOVE"   -> ReactionInfo -> EventInternalParse
InternalMessageReactionRemove forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"MESSAGE_REACTION_REMOVE_ALL" -> ChannelId -> MessageId -> EventInternalParse
InternalMessageReactionRemoveAll forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel_id"
                                                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message_id"
    Text
"MESSAGE_REACTION_REMOVE_EMOJI" -> ReactionRemoveInfo -> EventInternalParse
InternalMessageReactionRemoveEmoji forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"PRESENCE_UPDATE"           -> PresenceInfo -> EventInternalParse
InternalPresenceUpdate            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"TYPING_START"              -> TypingInfo -> EventInternalParse
InternalTypingStart               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
"USER_UPDATE"               -> User -> EventInternalParse
InternalUserUpdate                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o
    Text
_other_event                -> Text -> Object -> EventInternalParse
InternalUnknownEvent Text
t            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (ToJSON a, FromJSON b) => a -> Parser b
reparse Object
o