module Calamity.Cache.InMemory
( runCacheInMemory ) where
import Calamity.Cache.Eff
import Calamity.Internal.BoundedStore
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 Data.Foldable
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 -> BoundedStore Message
messages :: BoundedStore Message
}
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)
-> BoundedStore Message
-> 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 BoundedStore Message
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
runCache' Sem (CacheEff : r) a
m
runCache' :: P.Member (P.AtomicState Cache) r => CacheEff m a -> P.Sem r a
runCache' :: CacheEff m a -> Sem r a
runCache' 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
runCache CacheEff m a
act)
runCache :: CacheEff m a -> State Cache a
runCache :: CacheEff m a -> State Cache a
runCache (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
runCache 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
runCache (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
runCache (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)
runCache GetGuilds = SnowflakeMap Guild -> [Guild]
forall a. SnowflakeMap a -> [a]
SM.elems (SnowflakeMap Guild -> [Guild])
-> StateT Cache Identity (SnowflakeMap Guild)
-> StateT Cache Identity [Guild]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (SnowflakeMap Guild) Cache (SnowflakeMap Guild)
-> StateT Cache Identity (SnowflakeMap Guild)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"guilds" (Getting (SnowflakeMap Guild) Cache (SnowflakeMap Guild))
Getting (SnowflakeMap Guild) Cache (SnowflakeMap Guild)
#guilds
runCache (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
runCache (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
runCache (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)
runCache GetDMs = SnowflakeMap DMChannel -> [DMChannel]
forall a. SnowflakeMap a -> [a]
SM.elems (SnowflakeMap DMChannel -> [DMChannel])
-> StateT Cache Identity (SnowflakeMap DMChannel)
-> StateT Cache Identity [DMChannel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (SnowflakeMap DMChannel) Cache (SnowflakeMap DMChannel)
-> StateT Cache Identity (SnowflakeMap DMChannel)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"dms"
(Getting (SnowflakeMap DMChannel) Cache (SnowflakeMap DMChannel))
Getting (SnowflakeMap DMChannel) Cache (SnowflakeMap DMChannel)
#dms
runCache (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
runCache (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
runCache (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)
runCache GetUsers = SnowflakeMap User -> [User]
forall a. SnowflakeMap a -> [a]
SM.elems (SnowflakeMap User -> [User])
-> StateT Cache Identity (SnowflakeMap User)
-> StateT Cache Identity [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (SnowflakeMap User) Cache (SnowflakeMap User)
-> StateT Cache Identity (SnowflakeMap User)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"users" (Getting (SnowflakeMap User) Cache (SnowflakeMap User))
Getting (SnowflakeMap User) Cache (SnowflakeMap User)
#users
runCache (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
runCache (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
runCache (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)
runCache GetUnavailableGuilds = HashSet (Snowflake Guild) -> [Snowflake Guild]
forall a. HashSet a -> [a]
LS.toList (HashSet (Snowflake Guild) -> [Snowflake Guild])
-> StateT Cache Identity (HashSet (Snowflake Guild))
-> StateT Cache Identity [Snowflake Guild]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
(HashSet (Snowflake Guild)) Cache (HashSet (Snowflake Guild))
-> StateT Cache Identity (HashSet (Snowflake Guild))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"unavailableGuilds"
(Getting
(HashSet (Snowflake Guild)) Cache (HashSet (Snowflake Guild)))
Getting
(HashSet (Snowflake Guild)) Cache (HashSet (Snowflake Guild))
#unavailableGuilds
runCache (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
runCache (SetMessage m :: Message
m) = IsLabel
"messages"
(ASetter Cache Cache (BoundedStore Message) (BoundedStore Message))
ASetter Cache Cache (BoundedStore Message) (BoundedStore Message)
#messages ASetter Cache Cache (BoundedStore Message) (BoundedStore Message)
-> (BoundedStore Message -> BoundedStore Message)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Message -> BoundedStore Message -> BoundedStore Message
forall a. HasID' a => a -> BoundedStore a -> BoundedStore a
addItem Message
m
runCache (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"
((BoundedStore Message
-> Const (Maybe Message) (BoundedStore Message))
-> Cache -> Const a Cache)
(BoundedStore Message
-> Const (Maybe Message) (BoundedStore Message))
-> Cache -> Const a Cache
#messages ((BoundedStore Message
-> Const (Maybe Message) (BoundedStore Message))
-> Cache -> Const a Cache)
-> ((a -> Const a a)
-> BoundedStore Message
-> Const (Maybe Message) (BoundedStore Message))
-> Getting a Cache a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (BoundedStore Message)
-> Lens'
(BoundedStore Message) (Maybe (IxValue (BoundedStore Message)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (BoundedStore Message)
Snowflake Message
mid)
runCache GetMessages = BoundedStore Message -> [Message]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (BoundedStore Message -> [Message])
-> StateT Cache Identity (BoundedStore Message)
-> StateT Cache Identity [Message]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (BoundedStore Message) Cache (BoundedStore Message)
-> StateT Cache Identity (BoundedStore Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"messages"
(Getting (BoundedStore Message) Cache (BoundedStore Message))
Getting (BoundedStore Message) Cache (BoundedStore Message)
#messages
runCache (DelMessage mid :: Snowflake Message
mid) = IsLabel
"messages"
(ASetter Cache Cache (BoundedStore Message) (BoundedStore Message))
ASetter Cache Cache (BoundedStore Message) (BoundedStore Message)
#messages ASetter Cache Cache (BoundedStore Message) (BoundedStore Message)
-> (BoundedStore Message -> BoundedStore Message)
-> StateT Cache Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Index (BoundedStore Message)
-> BoundedStore Message -> BoundedStore Message
forall m. At m => Index m -> m -> m
sans Index (BoundedStore Message)
Snowflake Message
mid