{-# LANGUAGE OverloadedStrings #-}
module Discord.Internal.Gateway.Cache where
import Prelude hiding (log)
import Control.Monad (forever)
import Control.Concurrent.MVar
import Control.Concurrent.Chan
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Discord.Internal.Types
import Discord.Internal.Gateway.EventLoop
data Cache = Cache
{ Cache -> User
_currentUser :: User
, Cache -> Map ChannelId Channel
_dmChannels :: M.Map ChannelId Channel
, Cache -> Map ChannelId (Guild, GuildInfo)
_guilds :: M.Map GuildId (Guild, GuildInfo)
, Cache -> Map ChannelId Channel
_channels :: M.Map ChannelId Channel
} deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cache] -> ShowS
$cshowList :: [Cache] -> ShowS
show :: Cache -> String
$cshow :: Cache -> String
showsPrec :: Int -> Cache -> ShowS
$cshowsPrec :: Int -> Cache -> ShowS
Show)
type DiscordHandleCache = (Chan (Either GatewayException Event), MVar (Either (Cache, GatewayException) Cache))
cacheLoop :: DiscordHandleCache -> Chan T.Text -> IO ()
cacheLoop :: DiscordHandleCache -> Chan Text -> IO ()
cacheLoop (Chan (Either GatewayException Event)
eventChan, MVar (Either (Cache, GatewayException) Cache)
cache) Chan Text
log = do
Either GatewayException Event
ready <- Chan (Either GatewayException Event)
-> IO (Either GatewayException Event)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException Event)
eventChan
case Either GatewayException Event
ready of
Right (Ready Int
_ User
user [Channel]
dmChannels [GuildUnavailable]
_unavailableGuilds Text
_) -> do
let dmChans :: Map ChannelId Channel
dmChans = [(ChannelId, Channel)] -> Map ChannelId Channel
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([ChannelId] -> [Channel] -> [(ChannelId, Channel)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Channel -> ChannelId) -> [Channel] -> [ChannelId]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> ChannelId
channelId [Channel]
dmChannels) [Channel]
dmChannels)
MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (Cache -> Either (Cache, GatewayException) Cache
forall a b. b -> Either a b
Right (User
-> Map ChannelId Channel
-> Map ChannelId (Guild, GuildInfo)
-> Map ChannelId Channel
-> Cache
Cache User
user Map ChannelId Channel
dmChans Map ChannelId (Guild, GuildInfo)
forall k a. Map k a
M.empty Map ChannelId Channel
forall k a. Map k a
M.empty))
IO ()
loop
Right Event
r ->
Chan Text -> Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - expected Ready event, but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Event -> String
forall a. Show a => a -> String
show Event
r))
Left GatewayException
e ->
Chan Text -> Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - gateway exception " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GatewayException -> String
forall a. Show a => a -> String
show GatewayException
e))
where
loop :: IO ()
loop :: IO ()
loop = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Either GatewayException Event
eventOrExcept <- Chan (Either GatewayException Event)
-> IO (Either GatewayException Event)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException Event)
eventChan
Either (Cache, GatewayException) Cache
minfo <- MVar (Either (Cache, GatewayException) Cache)
-> IO (Either (Cache, GatewayException) Cache)
forall a. MVar a -> IO a
takeMVar MVar (Either (Cache, GatewayException) Cache)
cache
case Either (Cache, GatewayException) Cache
minfo of
Left (Cache, GatewayException)
nope -> MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache ((Cache, GatewayException) -> Either (Cache, GatewayException) Cache
forall a b. a -> Either a b
Left (Cache, GatewayException)
nope)
Right Cache
info -> case Either GatewayException Event
eventOrExcept of
Left GatewayException
e -> MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache ((Cache, GatewayException) -> Either (Cache, GatewayException) Cache
forall a b. a -> Either a b
Left (Cache
info, GatewayException
e))
Right Event
event -> MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (Cache -> Either (Cache, GatewayException) Cache
forall a b. b -> Either a b
Right (Cache -> Event -> Cache
adjustCache Cache
info Event
event))
adjustCache :: Cache -> Event -> Cache
adjustCache :: Cache -> Event -> Cache
adjustCache Cache
minfo Event
event = case Event
event of
GuildCreate Guild
guild GuildInfo
info ->
let newChans :: [Channel]
newChans = (Channel -> Channel) -> [Channel] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (ChannelId -> Channel -> Channel
setChanGuildID (Guild -> ChannelId
guildId Guild
guild)) ([Channel] -> [Channel]) -> [Channel] -> [Channel]
forall a b. (a -> b) -> a -> b
$ GuildInfo -> [Channel]
guildChannels GuildInfo
info
g :: Map ChannelId (Guild, GuildInfo)
g = ChannelId
-> (Guild, GuildInfo)
-> Map ChannelId (Guild, GuildInfo)
-> Map ChannelId (Guild, GuildInfo)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Guild -> ChannelId
guildId Guild
guild) (Guild
guild, GuildInfo
info { guildChannels :: [Channel]
guildChannels = [Channel]
newChans }) (Cache -> Map ChannelId (Guild, GuildInfo)
_guilds Cache
minfo)
c :: Map ChannelId Channel
c = (Channel -> Channel -> Channel)
-> Map ChannelId Channel
-> Map ChannelId Channel
-> Map ChannelId Channel
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (\Channel
a Channel
_ -> Channel
a)
([(ChannelId, Channel)] -> Map ChannelId Channel
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Channel -> ChannelId
channelId Channel
ch, Channel
ch) | Channel
ch <- [Channel]
newChans ])
(Cache -> Map ChannelId Channel
_channels Cache
minfo)
in Cache
minfo { _guilds :: Map ChannelId (Guild, GuildInfo)
_guilds = Map ChannelId (Guild, GuildInfo)
g, _channels :: Map ChannelId Channel
_channels = Map ChannelId Channel
c }
Event
_ -> Cache
minfo
setChanGuildID :: GuildId -> Channel -> Channel
setChanGuildID :: ChannelId -> Channel -> Channel
setChanGuildID ChannelId
s Channel
c = if Channel -> Bool
channelIsInGuild Channel
c
then Channel
c { channelGuild :: ChannelId
channelGuild = ChannelId
s }
else Channel
c