{-# LANGUAGE OverloadedStrings #-}

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

import Prelude hiding (log)
import Control.Monad (forever)
import Control.Concurrent.MVar
import Control.Concurrent.Chan
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
_currentUser :: User
            , Cache -> Map ChannelId Channel
_dmChannels :: M.Map ChannelId Channel
            , Cache -> Map ChannelId (Guild, GuildInfo)
_guilds :: M.Map GuildId (Guild, GuildInfo)
            , Cache -> Map ChannelId Channel
_channels :: M.Map ChannelId Channel
            } deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
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)

type DiscordHandleCache = (Chan (Either GatewayException Event), MVar (Either (Cache, GatewayException) Cache))

cacheLoop :: DiscordHandleCache -> Chan T.Text -> IO ()
cacheLoop :: DiscordHandleCache -> Chan Text -> IO ()
cacheLoop (Chan (Either GatewayException Event)
eventChan, MVar (Either (Cache, GatewayException) Cache)
cache) Chan Text
log = do
      Either GatewayException Event
ready <- Chan (Either GatewayException Event)
-> IO (Either GatewayException Event)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException Event)
eventChan
      case Either GatewayException Event
ready of
        Right (Ready Int
_ User
user [Channel]
dmChannels [GuildUnavailable]
_unavailableGuilds Text
_) -> do
          let dmChans :: Map ChannelId Channel
dmChans = [(ChannelId, Channel)] -> Map ChannelId Channel
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([ChannelId] -> [Channel] -> [(ChannelId, Channel)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Channel -> ChannelId) -> [Channel] -> [ChannelId]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> ChannelId
channelId [Channel]
dmChannels) [Channel]
dmChannels)
          MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (Cache -> Either (Cache, GatewayException) Cache
forall a b. b -> Either a b
Right (User
-> Map ChannelId Channel
-> Map ChannelId (Guild, GuildInfo)
-> Map ChannelId Channel
-> Cache
Cache User
user Map ChannelId Channel
dmChans Map ChannelId (Guild, GuildInfo)
forall k a. Map k a
M.empty Map ChannelId Channel
forall k a. Map k a
M.empty))
          IO ()
loop
        Right Event
r ->
          Chan Text -> Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - expected Ready event, but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Event -> String
forall a. Show a => a -> String
show Event
r))
        Left GatewayException
e ->
          Chan Text -> Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - gateway exception " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GatewayException -> String
forall a. Show a => a -> String
show GatewayException
e))
  where
  loop :: IO ()
  loop :: IO ()
loop = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Either GatewayException Event
eventOrExcept <- Chan (Either GatewayException Event)
-> IO (Either GatewayException Event)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException Event)
eventChan
    Either (Cache, GatewayException) Cache
minfo <- MVar (Either (Cache, GatewayException) Cache)
-> IO (Either (Cache, GatewayException) Cache)
forall a. MVar a -> IO a
takeMVar MVar (Either (Cache, GatewayException) Cache)
cache
    case Either (Cache, GatewayException) Cache
minfo of
      Left (Cache, GatewayException)
nope -> MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache ((Cache, GatewayException) -> Either (Cache, GatewayException) Cache
forall a b. a -> Either a b
Left (Cache, GatewayException)
nope)
      Right Cache
info -> case Either GatewayException Event
eventOrExcept of
                      Left GatewayException
e -> MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache ((Cache, GatewayException) -> Either (Cache, GatewayException) Cache
forall a b. a -> Either a b
Left (Cache
info, GatewayException
e))
                      Right Event
event -> MVar (Either (Cache, GatewayException) Cache)
-> Either (Cache, GatewayException) Cache -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (Cache -> Either (Cache, GatewayException) Cache
forall a b. b -> Either a b
Right (Cache -> Event -> Cache
adjustCache Cache
info Event
event))

adjustCache :: Cache -> Event -> Cache
adjustCache :: Cache -> Event -> Cache
adjustCache Cache
minfo Event
event = case Event
event of
  --ChannelCreate Channel
  --ChannelUpdate Channel
  --ChannelDelete Channel
  GuildCreate Guild
guild GuildInfo
info ->
    let newChans :: [Channel]
newChans = (Channel -> Channel) -> [Channel] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (ChannelId -> Channel -> Channel
setChanGuildID (Guild -> ChannelId
guildId Guild
guild)) ([Channel] -> [Channel]) -> [Channel] -> [Channel]
forall a b. (a -> b) -> a -> b
$ GuildInfo -> [Channel]
guildChannels GuildInfo
info
        g :: Map ChannelId (Guild, GuildInfo)
g = ChannelId
-> (Guild, GuildInfo)
-> Map ChannelId (Guild, GuildInfo)
-> Map ChannelId (Guild, GuildInfo)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Guild -> ChannelId
guildId Guild
guild) (Guild
guild, GuildInfo
info { guildChannels :: [Channel]
guildChannels = [Channel]
newChans }) (Cache -> Map ChannelId (Guild, GuildInfo)
_guilds Cache
minfo)
        c :: Map ChannelId Channel
c = (Channel -> Channel -> Channel)
-> Map ChannelId Channel
-> Map ChannelId Channel
-> Map ChannelId Channel
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (\Channel
a Channel
_ -> Channel
a)
                        ([(ChannelId, Channel)] -> Map ChannelId Channel
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
_channels Cache
minfo)
    in Cache
minfo { _guilds :: Map ChannelId (Guild, GuildInfo)
_guilds = Map ChannelId (Guild, GuildInfo)
g, _channels :: Map ChannelId Channel
_channels = Map ChannelId Channel
c }
  --GuildUpdate guild -> do
  --  let g = M.insert (guildId guild) guild (_guilds minfo)
  --      m2 = minfo { _guilds = g }
  --  putMVar cache m2
  --GuildDelete guild -> do
  --  let g = M.delete (guildId guild) (_guilds minfo)
  --      c = M.filterWithKey (\(keyGuildId,_) _ -> keyGuildId /= guildId guild) (_channels minfo)
  --      m2 = minfo { _guilds = g, _channels = c }
  --  putMVar cache m2
  Event
_ -> Cache
minfo

setChanGuildID :: GuildId -> Channel -> Channel
setChanGuildID :: ChannelId -> Channel -> Channel
setChanGuildID ChannelId
s Channel
c = if Channel -> Bool
channelIsInGuild Channel
c
                     then Channel
c { channelGuild :: ChannelId
channelGuild = ChannelId
s }
                     else Channel
c