{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Discord.Internal.Gateway.Cache where
import Prelude hiding (log)
import Control.Monad (forever, join, when)
import Control.Concurrent.MVar
import Control.Concurrent.Chan
import Data.Foldable (foldl')
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 (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds :: !(M.Map GuildId (Maybe (Guild, Maybe GuildCreateData)))
, Cache -> Map ChannelId Channel
cacheChannels :: !(M.Map ChannelId Channel)
, Cache -> FullApplication
cacheApplication :: !FullApplication
} 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 Cache
cacheHandleCache :: MVar Cache
}
initializeCache :: User -> FullApplication -> CacheHandle -> IO ()
initializeCache :: User -> FullApplication -> CacheHandle -> IO ()
initializeCache User
user FullApplication
app CacheHandle
cacheHandle = forall a. MVar a -> a -> IO ()
putMVar (CacheHandle -> MVar Cache
cacheHandleCache CacheHandle
cacheHandle) (User
-> Map ChannelId Channel
-> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
-> Map ChannelId Channel
-> FullApplication
-> 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 FullApplication
app)
cacheLoop :: Bool -> CacheHandle -> Chan T.Text -> IO ()
cacheLoop :: Bool -> CacheHandle -> Chan Text -> IO ()
cacheLoop Bool
isEnabled CacheHandle
cacheHandle Chan Text
_log = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEnabled forall a b. (a -> b) -> a -> b
$ 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 (CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents CacheHandle
cacheHandle)
case Either GatewayException EventInternalParse
eventOrExcept of
Left GatewayException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right EventInternalParse
event -> forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (CacheHandle -> MVar Cache
cacheHandleCache CacheHandle
cacheHandle) forall a b. (a -> b) -> a -> b
$! forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventInternalParse -> Cache -> Cache
adjustCache EventInternalParse
event
adjustCache :: EventInternalParse -> Cache -> Cache
adjustCache :: EventInternalParse -> Cache -> Cache
adjustCache EventInternalParse
event Cache
minfo = case EventInternalParse
event of
InternalReady Int
_ User
_ [GuildUnavailable]
gus Text
_ String
_ Maybe Shard
_ PartialApplication
_partialApp -> Cache
minfo { cacheGuilds :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo) (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ (\GuildUnavailable
gu -> (GuildUnavailable -> GuildId
idOnceAvailable GuildUnavailable
gu, forall a. Maybe a
Nothing)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuildUnavailable]
gus) }
InternalGuildCreate Guild
guild GuildCreateData
guildData ->
let newChans :: [Channel]
newChans = GuildCreateData -> [Channel]
guildCreateChannels GuildCreateData
guildData
g :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Guild -> GuildId
guildId Guild
guild) (forall a. a -> Maybe a
Just (Guild
guild, forall a. a -> Maybe a
Just GuildCreateData
guildData)) (Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo)
c :: Map ChannelId Channel
c = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
(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 (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g, cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
c }
InternalGuildUpdate Guild
guild ->
let gs :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
gs = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\case Just (Just (Guild
_, Maybe GuildCreateData
mCD)) -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just (Guild
guild, Maybe GuildCreateData
mCD)) ; Maybe (Maybe (Guild, Maybe GuildCreateData))
_ -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just (Guild
guild, forall a. Maybe a
Nothing)); ) (Guild -> GuildId
guildId Guild
guild) forall a b. (a -> b) -> a -> b
$ Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo
in Cache
minfo { cacheGuilds :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = Map GuildId (Maybe (Guild, Maybe GuildCreateData))
gs }
InternalGuildDelete GuildUnavailable
guild ->
let
toDelete :: Maybe (Guild, Maybe GuildCreateData)
toDelete = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo forall k a. Ord k => Map k a -> k -> Maybe a
M.!? GuildUnavailable -> GuildId
idOnceAvailable GuildUnavailable
guild
extraData :: Maybe GuildCreateData
extraData = forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Guild, Maybe GuildCreateData)
toDelete
channels :: [ChannelId]
channels = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Channel -> ChannelId
channelId forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildCreateData -> [Channel]
guildCreateChannels) Maybe GuildCreateData
extraData
g :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g = forall k a. Ord k => k -> Map k a -> Map k a
M.delete (GuildUnavailable -> GuildId
idOnceAvailable GuildUnavailable
guild) (Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo)
c :: Map ChannelId Channel
c = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
M.delete) (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo) [ChannelId]
channels
in Cache
minfo { cacheGuilds :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g, cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
c }
InternalChannelCreate Channel
c ->
let cm :: Map ChannelId Channel
cm = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Channel -> ChannelId
channelId Channel
c) Channel
c (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo)
in Cache
minfo { cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
cm }
InternalChannelUpdate Channel
c ->
let cm :: Map ChannelId Channel
cm = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Channel -> ChannelId
channelId Channel
c) Channel
c (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo)
in Cache
minfo { cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
cm }
InternalChannelDelete Channel
c ->
let cm :: Map ChannelId Channel
cm = forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Channel -> ChannelId
channelId Channel
c) (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo)
in Cache
minfo { cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
cm }
EventInternalParse
_ -> Cache
minfo