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

data Cache = Cache
     { Cache -> User
cacheCurrentUser :: !User
     , Cache -> Map ChannelId Channel
cacheDMChannels :: !(M.Map ChannelId Channel)
     , Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds :: !(M.Map GuildId (Maybe (Guild, Maybe GuildCreateData)))
     , Cache -> Map ChannelId Channel
cacheChannels :: !(M.Map ChannelId Channel)
     , Cache -> PartialApplication
cacheApplication :: !PartialApplication
     } deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
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 :: Bool -> CacheHandle -> Chan T.Text -> IO ()
cacheLoop :: Bool -> CacheHandle -> Chan Text -> IO ()
cacheLoop Bool
isEnabled CacheHandle
cacheHandle Chan Text
log = do
      Either GatewayException EventInternalParse
ready <- forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
eventChan
      case Either GatewayException EventInternalParse
ready of
        Right (InternalReady Int
_ User
user [GuildUnavailable]
_ Text
_ String
_ Maybe Shard
_ PartialApplication
pApp) -> do
          forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. b -> Either a b
Right (User
-> Map ChannelId Channel
-> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
-> Map ChannelId Channel
-> PartialApplication
-> Cache
Cache User
user forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty PartialApplication
pApp))
          IO ()
loop
        Right EventInternalParse
r ->
          forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - expected Ready event, but got " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show EventInternalParse
r))
        Left GatewayException
e ->
          forall a. Chan a -> a -> IO ()
writeChan Chan Text
log (Text
"cache - stopping cache - gateway exception " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (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 = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
    Either GatewayException EventInternalParse
eventOrExcept <- forall a. Chan a -> IO a
readChan Chan (Either GatewayException EventInternalParse)
eventChan
    if Bool -> Bool
not Bool
isEnabled
      then forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else do
        Either (Cache, GatewayException) Cache
minfo <- forall a. MVar a -> IO a
takeMVar MVar (Either (Cache, GatewayException) Cache)
cache
        case Either (Cache, GatewayException) Cache
minfo of
          Left (Cache, GatewayException)
nope -> forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. a -> Either a b
Left (Cache, GatewayException)
nope)
          Right Cache
info -> case Either GatewayException EventInternalParse
eventOrExcept of
                          Left GatewayException
e -> forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache (forall a b. a -> Either a b
Left (Cache
info, GatewayException
e))
                          Right EventInternalParse
event -> forall a. MVar a -> a -> IO ()
putMVar MVar (Either (Cache, GatewayException) Cache)
cache forall a b. (a -> b) -> a -> b
$! forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! 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
  InternalReady Int
_ User
_ [GuildUnavailable]
gus Text
_ String
_ Maybe Shard
_ PartialApplication
pa -> Cache
minfo { cacheApplication :: PartialApplication
cacheApplication = PartialApplication
pa, cacheGuilds :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo) (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ (\GuildUnavailable
gu -> (GuildUnavailable -> GuildId
idOnceAvailable GuildUnavailable
gu, forall a. Maybe a
Nothing)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuildUnavailable]
gus) }

  InternalGuildCreate Guild
guild GuildCreateData
guildData ->
    let newChans :: [Channel]
newChans = GuildCreateData -> [Channel]
guildCreateChannels GuildCreateData
guildData
        g :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Guild -> GuildId
guildId Guild
guild) (forall a. a -> Maybe a
Just (Guild
guild, forall a. a -> Maybe a
Just GuildCreateData
guildData)) (Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo)
        c :: Map ChannelId Channel
c = forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
              (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 GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g, cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
c }
  InternalGuildUpdate Guild
guild ->
    let gs :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
gs = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (\case Just (Just (Guild
_, Maybe GuildCreateData
mCD)) -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just (Guild
guild, Maybe GuildCreateData
mCD)) ; Maybe (Maybe (Guild, Maybe GuildCreateData))
_ -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just (Guild
guild, forall a. Maybe a
Nothing)); ) (Guild -> GuildId
guildId Guild
guild) forall a b. (a -> b) -> a -> b
$ Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo
    in Cache
minfo { cacheGuilds :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = Map GuildId (Maybe (Guild, Maybe GuildCreateData))
gs }
  InternalGuildDelete GuildUnavailable
guild ->
    let
      toDelete :: Maybe (Guild, Maybe GuildCreateData)
toDelete = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo forall k a. Ord k => Map k a -> k -> Maybe a
M.!? GuildUnavailable -> GuildId
idOnceAvailable GuildUnavailable
guild
      extraData :: Maybe GuildCreateData
extraData = forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Guild, Maybe GuildCreateData)
toDelete
      channels :: [ChannelId]
channels = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Channel -> ChannelId
channelId forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuildCreateData -> [Channel]
guildCreateChannels) Maybe GuildCreateData
extraData
      g :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g = forall k a. Ord k => k -> Map k a -> Map k a
M.delete (GuildUnavailable -> GuildId
idOnceAvailable GuildUnavailable
guild) (Cache -> Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds Cache
minfo)
      c :: Map ChannelId Channel
c = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Map k a
M.delete) (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo) [ChannelId]
channels
    in Cache
minfo { cacheGuilds :: Map GuildId (Maybe (Guild, Maybe GuildCreateData))
cacheGuilds = Map GuildId (Maybe (Guild, Maybe GuildCreateData))
g, cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
c }
  InternalChannelCreate Channel
c ->
    let cm :: Map ChannelId Channel
cm = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Channel -> ChannelId
channelId Channel
c) Channel
c (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo)
    in Cache
minfo { cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
cm }
  InternalChannelUpdate Channel
c ->
    let cm :: Map ChannelId Channel
cm = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Channel -> ChannelId
channelId Channel
c) Channel
c (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo)
    in Cache
minfo { cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
cm }
  InternalChannelDelete Channel
c ->
    let cm :: Map ChannelId Channel
cm = forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Channel -> ChannelId
channelId Channel
c) (Cache -> Map ChannelId Channel
cacheChannels Cache
minfo)
    in Cache
minfo { cacheChannels :: Map ChannelId Channel
cacheChannels = Map ChannelId Channel
cm }
  EventInternalParse
_ -> Cache
minfo