Cache.hs

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

-- | Query info about connected Guilds and Channels
module Discord.Internal.Gateway.Cache where

import Prelude hiding (log, Foldable(..))
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
     { cacheCurrentUser :: !User -- ^ Filled before onStart handler
     , cacheDMChannels :: !(M.Map ChannelId Channel) -- ^ Filled over time
     , cacheGuilds :: !(M.Map GuildId (Maybe (Guild, Maybe GuildCreateData))) -- ^ Filled over time
     , cacheChannels :: !(M.Map ChannelId Channel) -- ^ Filled over time
     , cacheApplication :: !FullApplication -- ^ Filled before onStart handler
     } deriving (Show)

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

-- | Internally used to setup the first cache
initializeCache :: User -> FullApplication -> CacheHandle -> IO ()
initializeCache user app cacheHandle = putMVar (cacheHandleCache cacheHandle) (Cache user M.empty M.empty M.empty app)

-- | IO loop to update cache on each gateway event
cacheLoop :: Bool -> CacheHandle -> Chan T.Text -> IO ()
cacheLoop isEnabled cacheHandle _log = when isEnabled $ forever $ do
    eventOrExcept <- readChan (cacheHandleEvents cacheHandle)
    case eventOrExcept of
      Left _ -> pure ()
      Right event -> modifyMVar_ (cacheHandleCache cacheHandle) $! pure . adjustCache event

-- | Apply gateway event to cache
adjustCache :: EventInternalParse -> Cache -> Cache
adjustCache event minfo = case event of
  -- note: ready only sends a partial app. we could update the info stored in the full app
  InternalReady _ _ gus _ _ _ _partialApp -> minfo { cacheGuilds = M.union (cacheGuilds minfo) (M.fromList $ (\gu -> (idOnceAvailable gu, Nothing)) <$> gus) }

  InternalGuildCreate guild guildData ->
    let newChans = guildCreateChannels guildData
        g = M.insert (guildId guild) (Just (guild, Just guildData)) (cacheGuilds minfo)
        c = M.union
              (M.fromList [ (channelId ch, ch) | ch <- newChans ])
              (cacheChannels minfo)
    in minfo { cacheGuilds = g, cacheChannels = c }
  InternalGuildUpdate guild ->
    let gs = M.alter (\case Just (Just (_, mCD)) -> Just (Just (guild, mCD)) ; _ -> Just (Just (guild, Nothing)); ) (guildId guild) $ cacheGuilds minfo
    in minfo { cacheGuilds = gs }
  InternalGuildDelete guild ->
    let
      toDelete = join $ cacheGuilds minfo M.!? idOnceAvailable guild
      extraData = snd =<< toDelete
      channels = maybe [] (fmap channelId . guildCreateChannels) extraData
      g = M.delete (idOnceAvailable guild) (cacheGuilds minfo)
      c = foldl' (flip M.delete) (cacheChannels minfo) channels
    in minfo { cacheGuilds = g, cacheChannels = c }
  InternalChannelCreate c ->
    let cm = M.insert (channelId c) c (cacheChannels minfo)
    in minfo { cacheChannels = cm }
  InternalChannelUpdate c ->
    let cm = M.insert (channelId c) c (cacheChannels minfo)
    in minfo { cacheChannels = cm }
  InternalChannelDelete c ->
    let cm = M.delete (channelId c) (cacheChannels minfo)
    in minfo { cacheChannels = cm }
  _ -> minfo