Cache.hs

{-# 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
     { 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