{-# 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
cacheCurrentUser :: User
, Cache -> Map ChannelId Channel
cacheDMChannels :: M.Map ChannelId Channel
, Cache -> Map GuildId Guild
cacheGuilds :: M.Map GuildId Guild
, Cache -> Map ChannelId Channel
cacheChannels :: M.Map ChannelId Channel
, Cache -> PartialApplication
cacheApplication :: PartialApplication
} deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
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)
data CacheHandle = CacheHandle
{ CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents :: Chan (Either GatewayException EventInternalParse)
, CacheHandle -> MVar (Either (Cache, GatewayException) Cache)
cacheHandleCache :: MVar (Either (Cache, GatewayException) Cache)
}
cacheLoop :: CacheHandle -> Chan T.Text -> IO ()
cacheLoop :: CacheHandle -> Chan Text -> IO ()
cacheLoop CacheHandle
cacheHandle Chan Text
log = do
Either GatewayException EventInternalParse
ready <- forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
eventChan
case Either GatewayException EventInternalParse
ready of
Right (InternalReady Int
_ User
user [GuildUnavailable]
_ Text
_ String
_ Maybe Shard
_ PartialApplication
pApp) -> do
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. b -> Either a b
Right (User
-> Map ChannelId Channel
-> Map GuildId Guild
-> Map ChannelId Channel
-> PartialApplication
-> Cache
Cache User
user forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty PartialApplication
pApp))
IO ()
loop
Right EventInternalParse
r ->
forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - expected Ready event, but got " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show EventInternalParse
r))
Left GatewayException
e ->
forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - gateway exception " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show GatewayException
e))
where
cache :: MVar (Either (Cache, GatewayException) Cache)
cache = CacheHandle -> MVar (Either (Cache, GatewayException) Cache)
cacheHandleCache CacheHandle
cacheHandle
eventChan :: Chan (Either GatewayException EventInternalParse)
eventChan = CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents CacheHandle
cacheHandle
loop :: IO ()
loop :: IO ()
loop = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Either GatewayException EventInternalParse
eventOrExcept <- forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
eventChan
Either (Cache, GatewayException) Cache
minfo <- forall a. MVar a -> IO a
takeMVar MVar (Either (Cache, GatewayException) Cache)
cache
case Either (Cache, GatewayException) Cache
minfo of
Left (Cache, GatewayException)
nope -> forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. a -> Either a b
Left (Cache, GatewayException)
nope)
Right Cache
info -> case Either GatewayException EventInternalParse
eventOrExcept of
Left GatewayException
e -> forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. a -> Either a b
Left (Cache
info, GatewayException
e))
Right EventInternalParse
event -> forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. b -> Either a b
Right (Cache -> EventInternalParse -> Cache
adjustCache Cache
info EventInternalParse
event))
adjustCache :: Cache -> EventInternalParse -> Cache
adjustCache :: Cache -> EventInternalParse -> Cache
adjustCache Cache
minfo EventInternalParse
event = case EventInternalParse
event of
InternalGuildCreate Guild
guild ->
let newChans :: [Channel]
newChans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map (GuildId -> Channel -> Channel
setChanGuildID (Guild -> GuildId
guildId Guild
guild))) (Guild -> Maybe [Channel]
guildChannels Guild
guild)
g :: Map GuildId Guild
g = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Guild -> GuildId
guildId Guild
guild) (Guild
guild { guildChannels :: Maybe [Channel]
guildChannels = forall a. a -> Maybe a
Just [Channel]
newChans }) (Cache -> Map GuildId Guild
cacheGuilds Cache
minfo)
c :: Map ChannelId Channel
c = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a b. a -> b -> a
const
(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
cacheChannels Cache
minfo)
in Cache
minfo { cacheGuilds :: Map GuildId Guild
cacheGuilds = Map GuildId Guild
g, cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
c }
InternalReady Int
_ User
_ [GuildUnavailable]
_ Text
_ String
_ Maybe Shard
_ PartialApplication
pa -> Cache
minfo { cacheApplication :: PartialApplication
cacheApplication = PartialApplication
pa }
EventInternalParse
_ -> Cache
minfo
setChanGuildID :: GuildId -> Channel -> Channel
setChanGuildID :: GuildId -> Channel -> Channel
setChanGuildID GuildId
s Channel
c = if Channel -> Bool
channelIsInGuild Channel
c
then Channel
c { channelGuild :: GuildId
channelGuild = GuildId
s }
else Channel
c