module Calamity.Cache.InMemory
( runCacheInMemory ) where
import Calamity.Cache.Eff
import Calamity.Internal.MessageStore
import qualified Calamity.Internal.SnowflakeMap as SM
import Calamity.Internal.Utils
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import Control.Lens
import Control.Monad.State.Strict
import Data.Default.Class
import qualified Data.HashSet as LS
import Data.IORef
import GHC.Generics
import qualified Polysemy as P
import qualified Polysemy.AtomicState as P
data Cache = Cache
{ Cache -> Maybe User
user :: Maybe User
, Cache -> SnowflakeMap Guild
guilds :: SM.SnowflakeMap Guild
, Cache -> SnowflakeMap DMChannel
dms :: SM.SnowflakeMap DMChannel
, Cache -> SnowflakeMap GuildChannel
channels :: SM.SnowflakeMap GuildChannel
, Cache -> SnowflakeMap User
users :: SM.SnowflakeMap User
, Cache -> HashSet (Snowflake Guild)
unavailableGuilds :: LS.HashSet (Snowflake Guild)
, Cache -> MessageStore
messages :: MessageStore
}
deriving ( (forall x. Cache -> Rep Cache x)
-> (forall x. Rep Cache x -> Cache) -> Generic Cache
forall x. Rep Cache x -> Cache
forall x. Cache -> Rep Cache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cache x -> Cache
$cfrom :: forall x. Cache -> Rep Cache x
Generic, 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 )
emptyCache :: Cache
emptyCache :: Cache
emptyCache = Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> SnowflakeMap GuildChannel
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> MessageStore
-> Cache
Cache Maybe User
forall a. Maybe a
Nothing SnowflakeMap Guild
forall a. SnowflakeMap a
SM.empty SnowflakeMap DMChannel
forall a. SnowflakeMap a
SM.empty SnowflakeMap GuildChannel
forall a. SnowflakeMap a
SM.empty SnowflakeMap User
forall a. SnowflakeMap a
SM.empty HashSet (Snowflake Guild)
forall a. HashSet a
LS.empty MessageStore
forall a. Default a => a
def
runCacheInMemory :: P.Member (P.Embed IO) r => P.Sem (CacheEff ': r) a -> P.Sem r a
runCacheInMemory :: Sem (CacheEff : r) a -> Sem r a
runCacheInMemory m :: Sem (CacheEff : r) a
m = do
IORef Cache
var <- IO (IORef Cache) -> Sem r (IORef Cache)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO (IORef Cache) -> Sem r (IORef Cache))
-> IO (IORef Cache) -> Sem r (IORef Cache)
forall a b. (a -> b) -> a -> b
$ Cache -> IO (IORef Cache)
forall a. a -> IO (IORef a)
newIORef Cache
emptyCache
IORef Cache -> Sem (AtomicState Cache : r) a -> Sem r a
forall s (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IORef s -> Sem (AtomicState s : r) a -> Sem r a
P.runAtomicStateIORef IORef Cache
var (Sem (AtomicState Cache : r) a -> Sem r a)
-> Sem (AtomicState Cache : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) x.
CacheEff m x -> Sem (AtomicState Cache : r) x)
-> Sem (CacheEff : r) a -> Sem (AtomicState Cache : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret" =>
(forall (m :: * -> *) x. e1 m x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpret forall k (r :: [(* -> *) -> * -> *]) (m :: k) a.
Member (AtomicState Cache) r =>
CacheEff m a -> Sem r a
forall (m :: * -> *) x.
CacheEff m x -> Sem (AtomicState Cache : r) x
updateCache' Sem (CacheEff : r) a
m
updateCache' :: P.Member (P.AtomicState Cache) r => CacheEff m a -> P.Sem r a
updateCache' :: CacheEff m a -> Sem r a
updateCache' act :: CacheEff m a
act = (Cache -> (Cache, a)) -> Sem r a
forall s a (r :: [(* -> *) -> * -> *]).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
P.atomicState' (((a, Cache) -> (Cache, a)
forall a b. (a, b) -> (b, a)
swap ((a, Cache) -> (Cache, a))
-> (Cache -> (a, Cache)) -> Cache -> (Cache, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Cache -> (a, Cache)) -> Cache -> (Cache, a))
-> (State Cache a -> Cache -> (a, Cache))
-> State Cache a
-> Cache
-> (Cache, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Cache a -> Cache -> (a, Cache)
forall s a. State s a -> s -> (a, s)
runState (State Cache a -> Cache -> (Cache, a))
-> State Cache a -> Cache -> (Cache, a)
forall a b. (a -> b) -> a -> b
$ CacheEff m a -> State Cache a
forall k (m :: k) a. CacheEff m a -> State Cache a
updateCache CacheEff m a
act)
updateCache :: CacheEff m a -> State Cache a
updateCache :: CacheEff m a -> State Cache a
updateCache (SetBotUser u :: User
u) = IsLabel "user" (ASetter Cache Cache (Maybe User) (Maybe User))
ASetter Cache Cache (Maybe User) (Maybe User)
#user ASetter Cache Cache (Maybe User) (Maybe User)
-> User -> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= User
u
updateCache GetBotUser = Getting a Cache a -> State Cache a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel "user" (Getting a Cache a)
Getting a Cache a
#user
updateCache (SetGuild g :: Guild
g) = IsLabel
"guilds"
(ASetter Cache Cache (SnowflakeMap Guild) (SnowflakeMap Guild))
ASetter Cache Cache (SnowflakeMap Guild) (SnowflakeMap Guild)
#guilds ASetter Cache Cache (SnowflakeMap Guild) (SnowflakeMap Guild)
-> (SnowflakeMap Guild -> SnowflakeMap Guild)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Guild -> SnowflakeMap Guild -> SnowflakeMap Guild
forall a. HasID' a => a -> SnowflakeMap a -> SnowflakeMap a
SM.insert Guild
g
updateCache (GetGuild gid :: Snowflake Guild
gid) = Getting a Cache a -> State Cache a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (IsLabel
"guilds"
((SnowflakeMap Guild -> Const (Maybe Guild) (SnowflakeMap Guild))
-> Cache -> Const a Cache)
(SnowflakeMap Guild -> Const (Maybe Guild) (SnowflakeMap Guild))
-> Cache -> Const a Cache
#guilds ((SnowflakeMap Guild -> Const (Maybe Guild) (SnowflakeMap Guild))
-> Cache -> Const a Cache)
-> ((a -> Const a a)
-> SnowflakeMap Guild -> Const (Maybe Guild) (SnowflakeMap Guild))
-> Getting a Cache a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Guild)
-> Lens'
(SnowflakeMap Guild) (Maybe (IxValue (SnowflakeMap Guild)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap Guild)
Snowflake Guild
gid)
updateCache (DelGuild gid :: Snowflake Guild
gid) = IsLabel
"guilds"
(ASetter Cache Cache (SnowflakeMap Guild) (SnowflakeMap Guild))
ASetter Cache Cache (SnowflakeMap Guild) (SnowflakeMap Guild)
#guilds ASetter Cache Cache (SnowflakeMap Guild) (SnowflakeMap Guild)
-> (SnowflakeMap Guild -> SnowflakeMap Guild)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Index (SnowflakeMap Guild)
-> SnowflakeMap Guild -> SnowflakeMap Guild
forall m. At m => Index m -> m -> m
sans Index (SnowflakeMap Guild)
Snowflake Guild
gid
updateCache (SetDM dm :: DMChannel
dm) = IsLabel
"dms"
(ASetter
Cache Cache (SnowflakeMap DMChannel) (SnowflakeMap DMChannel))
ASetter
Cache Cache (SnowflakeMap DMChannel) (SnowflakeMap DMChannel)
#dms ASetter
Cache Cache (SnowflakeMap DMChannel) (SnowflakeMap DMChannel)
-> (SnowflakeMap DMChannel -> SnowflakeMap DMChannel)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= DMChannel -> SnowflakeMap DMChannel -> SnowflakeMap DMChannel
forall a. HasID' a => a -> SnowflakeMap a -> SnowflakeMap a
SM.insert DMChannel
dm
updateCache (GetDM did :: Snowflake DMChannel
did) = Getting a Cache a -> State Cache a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (IsLabel
"dms"
((SnowflakeMap DMChannel
-> Const (Maybe DMChannel) (SnowflakeMap DMChannel))
-> Cache -> Const a Cache)
(SnowflakeMap DMChannel
-> Const (Maybe DMChannel) (SnowflakeMap DMChannel))
-> Cache -> Const a Cache
#dms ((SnowflakeMap DMChannel
-> Const (Maybe DMChannel) (SnowflakeMap DMChannel))
-> Cache -> Const a Cache)
-> ((a -> Const a a)
-> SnowflakeMap DMChannel
-> Const (Maybe DMChannel) (SnowflakeMap DMChannel))
-> Getting a Cache a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap DMChannel)
-> Lens'
(SnowflakeMap DMChannel) (Maybe (IxValue (SnowflakeMap DMChannel)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap DMChannel)
Snowflake DMChannel
did)
updateCache (DelDM did :: Snowflake DMChannel
did) = IsLabel
"dms"
(ASetter
Cache Cache (SnowflakeMap DMChannel) (SnowflakeMap DMChannel))
ASetter
Cache Cache (SnowflakeMap DMChannel) (SnowflakeMap DMChannel)
#dms ASetter
Cache Cache (SnowflakeMap DMChannel) (SnowflakeMap DMChannel)
-> (SnowflakeMap DMChannel -> SnowflakeMap DMChannel)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Index (SnowflakeMap DMChannel)
-> SnowflakeMap DMChannel -> SnowflakeMap DMChannel
forall m. At m => Index m -> m -> m
sans Index (SnowflakeMap DMChannel)
Snowflake DMChannel
did
updateCache (SetUser u :: User
u) = IsLabel
"users"
(ASetter Cache Cache (SnowflakeMap User) (SnowflakeMap User))
ASetter Cache Cache (SnowflakeMap User) (SnowflakeMap User)
#users ASetter Cache Cache (SnowflakeMap User) (SnowflakeMap User)
-> (SnowflakeMap User -> SnowflakeMap User)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= User -> SnowflakeMap User -> SnowflakeMap User
forall a. HasID' a => a -> SnowflakeMap a -> SnowflakeMap a
SM.insert User
u
updateCache (GetUser uid :: Snowflake User
uid) = Getting a Cache a -> State Cache a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (IsLabel
"users"
((SnowflakeMap User -> Const (Maybe User) (SnowflakeMap User))
-> Cache -> Const a Cache)
(SnowflakeMap User -> Const (Maybe User) (SnowflakeMap User))
-> Cache -> Const a Cache
#users ((SnowflakeMap User -> Const (Maybe User) (SnowflakeMap User))
-> Cache -> Const a Cache)
-> ((a -> Const a a)
-> SnowflakeMap User -> Const (Maybe User) (SnowflakeMap User))
-> Getting a Cache a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap User)
-> Lens' (SnowflakeMap User) (Maybe (IxValue (SnowflakeMap User)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (SnowflakeMap User)
Snowflake User
uid)
updateCache (DelUser uid :: Snowflake User
uid) = IsLabel
"users"
(ASetter Cache Cache (SnowflakeMap User) (SnowflakeMap User))
ASetter Cache Cache (SnowflakeMap User) (SnowflakeMap User)
#users ASetter Cache Cache (SnowflakeMap User) (SnowflakeMap User)
-> (SnowflakeMap User -> SnowflakeMap User)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Index (SnowflakeMap User) -> SnowflakeMap User -> SnowflakeMap User
forall m. At m => Index m -> m -> m
sans Index (SnowflakeMap User)
Snowflake User
uid
updateCache (SetUnavailableGuild gid :: Snowflake Guild
gid) = IsLabel
"unavailableGuilds"
(ASetter
Cache
Cache
(HashSet (Snowflake Guild))
(HashSet (Snowflake Guild)))
ASetter
Cache Cache (HashSet (Snowflake Guild)) (HashSet (Snowflake Guild))
#unavailableGuilds ASetter
Cache Cache (HashSet (Snowflake Guild)) (HashSet (Snowflake Guild))
-> (HashSet (Snowflake Guild) -> HashSet (Snowflake Guild))
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Snowflake Guild
-> HashSet (Snowflake Guild) -> HashSet (Snowflake Guild)
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
LS.insert Snowflake Guild
gid
updateCache (IsUnavailableGuild gid :: Snowflake Guild
gid) = Getting Bool Cache Bool -> StateT Cache Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (IsLabel
"unavailableGuilds"
((HashSet (Snowflake Guild)
-> Const Bool (HashSet (Snowflake Guild)))
-> Cache -> Const Bool Cache)
(HashSet (Snowflake Guild)
-> Const Bool (HashSet (Snowflake Guild)))
-> Cache -> Const Bool Cache
#unavailableGuilds ((HashSet (Snowflake Guild)
-> Const Bool (HashSet (Snowflake Guild)))
-> Cache -> Const Bool Cache)
-> ((Bool -> Const Bool Bool)
-> HashSet (Snowflake Guild)
-> Const Bool (HashSet (Snowflake Guild)))
-> Getting Bool Cache Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashSet (Snowflake Guild))
-> Lens' (HashSet (Snowflake Guild)) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index (HashSet (Snowflake Guild))
Snowflake Guild
gid)
updateCache (DelUnavailableGuild gid :: Snowflake Guild
gid) = IsLabel
"unavailableGuilds"
(ASetter
Cache
Cache
(HashSet (Snowflake Guild))
(HashSet (Snowflake Guild)))
ASetter
Cache Cache (HashSet (Snowflake Guild)) (HashSet (Snowflake Guild))
#unavailableGuilds ASetter
Cache Cache (HashSet (Snowflake Guild)) (HashSet (Snowflake Guild))
-> (HashSet (Snowflake Guild) -> HashSet (Snowflake Guild))
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Index (HashSet (Snowflake Guild))
-> HashSet (Snowflake Guild) -> HashSet (Snowflake Guild)
forall m. At m => Index m -> m -> m
sans Index (HashSet (Snowflake Guild))
Snowflake Guild
gid
updateCache (SetMessage m :: Message
m) = IsLabel "messages" (ASetter Cache Cache MessageStore MessageStore)
ASetter Cache Cache MessageStore MessageStore
#messages ASetter Cache Cache MessageStore MessageStore
-> (MessageStore -> MessageStore) -> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Message -> MessageStore -> MessageStore
addMessage Message
m
updateCache (GetMessage mid :: Snowflake Message
mid) = Getting a Cache a -> State Cache a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (IsLabel
"messages"
((MessageStore -> Const (Maybe Message) MessageStore)
-> Cache -> Const a Cache)
(MessageStore -> Const (Maybe Message) MessageStore)
-> Cache -> Const a Cache
#messages ((MessageStore -> Const (Maybe Message) MessageStore)
-> Cache -> Const a Cache)
-> ((a -> Const a a)
-> MessageStore -> Const (Maybe Message) MessageStore)
-> Getting a Cache a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index MessageStore
-> Lens' MessageStore (Maybe (IxValue MessageStore))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index MessageStore
Snowflake Message
mid)
updateCache (DelMessage mid :: Snowflake Message
mid) = IsLabel "messages" (ASetter Cache Cache MessageStore MessageStore)
ASetter Cache Cache MessageStore MessageStore
#messages ASetter Cache Cache MessageStore MessageStore
-> (MessageStore -> MessageStore) -> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Index MessageStore -> MessageStore -> MessageStore
forall m. At m => Index m -> m -> m
sans Index MessageStore
Snowflake Message
mid