{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune, not-home #-}
module Discord.Gateway.Cache where
import Prelude hiding (log)
import Data.Monoid ((<>))
import Control.Concurrent.MVar
import Control.Concurrent.Chan
import qualified Data.Map.Strict as M
import Discord.Types
data Cache = Cache
{ _currentUser :: User
, _dmChannels :: M.Map Snowflake Channel
, _guilds :: M.Map Snowflake (Guild, GuildInfo)
, _channels :: M.Map Snowflake Channel
} deriving (Show)
emptyCache :: IO (MVar Cache)
emptyCache = newEmptyMVar
addEvent :: MVar Cache -> Chan Event -> Chan String -> IO ()
addEvent cache eventChan log = do
ready <- readChan eventChan
case ready of
(Ready _ user dmChannels _unavailableGuilds _) -> do
let dmChans = M.fromList (zip (map channelId dmChannels) dmChannels)
putMVar cache (Cache user dmChans M.empty M.empty)
loop
_ -> do
writeChan log ("Cache error - expected Ready, but got " <> show ready)
addEvent cache eventChan log
where
loop :: IO ()
loop = do
event <- readChan eventChan
minfo <- takeMVar cache
putMVar cache (adjustCache minfo event)
loop
adjustCache :: Cache -> Event -> Cache
adjustCache minfo event = case event of
GuildCreate guild info ->
let newChans = map (setChanGuildID (guildId guild)) $ guildChannels info
g = M.insert (guildId guild) (guild, info { guildChannels = newChans }) (_guilds minfo)
c = M.unionWith (\a _ -> a)
(M.fromList [ (channelId ch, ch) | ch <- newChans ])
(_channels minfo)
in minfo { _guilds = g, _channels = c }
_ -> minfo
setChanGuildID :: Snowflake -> Channel -> Channel
setChanGuildID s c = if isGuildChannel c
then c { channelGuild = s }
else c