{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

-- | Query info about connected Guilds and Channels
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

-- |  Cached data from gateway. Set RunDiscordOpts.discordEnableCache=true to enable all the fields
data Cache = Cache
     { Cache -> User
cacheCurrentUser :: !User -- ^ Filled before onStart handler
     , Cache -> Map ChannelId Channel
cacheDMChannels :: !(M.Map ChannelId Channel) -- ^ Filled over time
     , Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds :: !(M.Map GuildId (Maybe (Guild, Maybe GuildCreateData))) -- ^ Filled over time
     , Cache -> Map ChannelId Channel
cacheChannels :: !(M.Map ChannelId Channel) -- ^ Filled over time
     , Cache -> FullApplication
cacheApplication :: !FullApplication -- ^ Filled before onStart handler
     } 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)

-- | Internal handle for cacheLoop to manage the cache
data CacheHandle = CacheHandle
  { CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents :: Chan (Either GatewayException EventInternalParse) -- ^ Read gateway events
  , CacheHandle -> MVar Cache
cacheHandleCache  :: MVar Cache -- ^ Current cache.
  }

-- | Internally used to setup the first 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)

-- | IO loop to update cache on each gateway event
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

-- | Apply gateway event to cache
adjustCache :: EventInternalParse -> Cache -> Cache
adjustCache :: EventInternalParse -> Cache -> Cache
adjustCache EventInternalParse
event Cache
minfo = case EventInternalParse
event of
  -- note: ready only sends a partial app. we could update the info stored in the full app
  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