-- | A 'Cache' handler that operates in memory
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