{-# 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
cacheCurrentUser :: User
     , Cache -> Map ChannelId Channel
cacheDMChannels :: M.Map ChannelId Channel
     , Cache -> Map ChannelId (Guild, GuildInfo)
cacheGuilds :: M.Map GuildId (Guild, GuildInfo)
     , Cache -> Map ChannelId Channel
cacheChannels :: M.Map ChannelId Channel
     , Cache -> PartialApplication
cacheApplication :: PartialApplication
     } 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)

data CacheHandle = CacheHandle
  { CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents :: Chan (Either GatewayException EventInternalParse)
  , CacheHandle -> MVar (Either (Cache, GatewayException) Cache)
cacheHandleCache  :: MVar (Either (Cache, GatewayException) Cache)
  }

cacheLoop :: CacheHandle -> Chan T.Text -> IO ()
cacheLoop :: CacheHandle -> Chan Text -> IO ()
cacheLoop CacheHandle
cacheHandle Chan Text
log = do
      Either GatewayException EventInternalParse
ready <- Chan (Either GatewayException EventInternalParse)
-> IO (Either GatewayException EventInternalParse)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
eventChan
      case Either GatewayException EventInternalParse
ready of
        Right (InternalReady Int
_ User
user [Channel]
dmChannels [GuildUnavailable]
_unavailableGuilds Text
_ Maybe Shard
_ PartialApplication
pApp) -> 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
-> PartialApplication
-> 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 PartialApplication
pApp))
          IO ()
loop
        Right EventInternalParse
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 (EventInternalParse -> String
forall a. Show a => a -> String
show EventInternalParse
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
  cache :: MVar (Either (Cache, GatewayException) Cache)
cache     = CacheHandle -> MVar (Either (Cache, GatewayException) Cache)
cacheHandleCache CacheHandle
cacheHandle
  eventChan :: Chan (Either GatewayException EventInternalParse)
eventChan = CacheHandle -> Chan (Either GatewayException EventInternalParse)
cacheHandleEvents CacheHandle
cacheHandle

  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 EventInternalParse
eventOrExcept <- Chan (Either GatewayException EventInternalParse)
-> IO (Either GatewayException EventInternalParse)
forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
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 EventInternalParse
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 EventInternalParse
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 -> EventInternalParse -> Cache
adjustCache Cache
info EventInternalParse
event))

adjustCache :: Cache -> EventInternalParse -> Cache
adjustCache :: Cache -> EventInternalParse -> Cache
adjustCache Cache
minfo EventInternalParse
event = case EventInternalParse
event of
  --InternalChannelCreate Channel
  --InternalChannelUpdate Channel
  --InternalChannelDelete Channel
  InternalGuildCreate 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)
cacheGuilds 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
cacheChannels Cache
minfo)
    in Cache
minfo { cacheGuilds :: Map ChannelId (Guild, GuildInfo)
cacheGuilds = Map ChannelId (Guild, GuildInfo)
g, cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
c }
  --InternalGuildUpdate guild -> do
  --  let g = M.insert (guildId guild) guild (cacheGuilds minfo)
  --      m2 = minfo { cacheGuilds = g }
  --  putMVar cache m2
  --InternalGuildDelete guild -> do
  --  let g = M.delete (guildId guild) (cacheGuilds minfo)
  --      c = M.filterWithKey (\(keyGuildId,_) _ -> keyGuildId /= guildId guild) (cacheChannels minfo)
  --      m2 = minfo { cacheGuilds = g, cacheChannels = c }
  --  putMVar cache m2
  InternalReady Int
_ User
_ [Channel]
_ [GuildUnavailable]
_ Text
_ Maybe Shard
_ PartialApplication
pa -> Cache
minfo { cacheApplication :: PartialApplication
cacheApplication = PartialApplication
pa }
  EventInternalParse
_ -> 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