{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}

-- | A 'Cache' handler that operates in memory
module Calamity.Cache.InMemory (
  runCacheInMemory,
  runCacheInMemory',
  runCacheInMemoryNoMsg,
) where

import Calamity.Cache.Eff
import Calamity.Internal.BoundedStore qualified as BS
import Calamity.Internal.SnowflakeMap qualified 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.Applicative
import Control.Monad.State.Strict
import Data.Foldable
import Data.Functor.Identity
import Data.HashMap.Strict qualified as SH
import Data.HashSet qualified as HS
import Data.IORef
import Optics
import Optics.State.Operators ((%=), (?=))
import Polysemy qualified as P
import Polysemy.AtomicState qualified as P

data Cache f = Cache
  { forall (f :: * -> *). Cache f -> Maybe User
user :: Maybe User
  , forall (f :: * -> *). Cache f -> SnowflakeMap Guild
guilds :: !(SM.SnowflakeMap Guild)
  , forall (f :: * -> *). Cache f -> SnowflakeMap DMChannel
dms :: !(SM.SnowflakeMap DMChannel)
  , forall (f :: * -> *).
Cache f -> HashMap (Snowflake GuildChannel) Guild
guildChannels :: !(SH.HashMap (Snowflake GuildChannel) Guild)
  , forall (f :: * -> *). Cache f -> SnowflakeMap User
users :: !(SM.SnowflakeMap User)
  , forall (f :: * -> *). Cache f -> HashSet (Snowflake Guild)
unavailableGuilds :: !(HS.HashSet (Snowflake Guild))
  , forall (f :: * -> *). Cache f -> f (BoundedStore Message)
messages :: !(f (BS.BoundedStore Message))
  }

$(makeFieldLabelsNoPrefix ''Cache)

type CacheWithMsg = Cache Identity
type CacheNoMsg = Cache (Const ())

emptyCache :: CacheWithMsg
emptyCache :: CacheWithMsg
emptyCache = Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> HashMap (Snowflake GuildChannel) Guild
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> Identity (BoundedStore Message)
-> CacheWithMsg
forall (f :: * -> *).
Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> HashMap (Snowflake GuildChannel) Guild
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> f (BoundedStore Message)
-> Cache f
Cache Maybe User
forall a. Maybe a
Nothing SnowflakeMap Guild
forall a. SnowflakeMap a
SM.empty SnowflakeMap DMChannel
forall a. SnowflakeMap a
SM.empty HashMap (Snowflake GuildChannel) Guild
forall k v. HashMap k v
SH.empty SnowflakeMap User
forall a. SnowflakeMap a
SM.empty HashSet (Snowflake Guild)
forall a. HashSet a
HS.empty (BoundedStore Message -> Identity (BoundedStore Message)
forall a. a -> Identity a
Identity (BoundedStore Message -> Identity (BoundedStore Message))
-> BoundedStore Message -> Identity (BoundedStore Message)
forall a b. (a -> b) -> a -> b
$ Int -> BoundedStore Message
forall a. Int -> BoundedStore a
BS.empty Int
1000)

emptyCacheNoMsg :: CacheNoMsg
emptyCacheNoMsg :: CacheNoMsg
emptyCacheNoMsg = Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> HashMap (Snowflake GuildChannel) Guild
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> Const () (BoundedStore Message)
-> CacheNoMsg
forall (f :: * -> *).
Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> HashMap (Snowflake GuildChannel) Guild
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> f (BoundedStore Message)
-> Cache f
Cache Maybe User
forall a. Maybe a
Nothing SnowflakeMap Guild
forall a. SnowflakeMap a
SM.empty SnowflakeMap DMChannel
forall a. SnowflakeMap a
SM.empty HashMap (Snowflake GuildChannel) Guild
forall k v. HashMap k v
SH.empty SnowflakeMap User
forall a. SnowflakeMap a
SM.empty HashSet (Snowflake Guild)
forall a. HashSet a
HS.empty (() -> Const () (BoundedStore Message)
forall {k} a (b :: k). a -> Const a b
Const ())

emptyCache' :: Int -> CacheWithMsg
emptyCache' :: Int -> CacheWithMsg
emptyCache' Int
msgLimit = Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> HashMap (Snowflake GuildChannel) Guild
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> Identity (BoundedStore Message)
-> CacheWithMsg
forall (f :: * -> *).
Maybe User
-> SnowflakeMap Guild
-> SnowflakeMap DMChannel
-> HashMap (Snowflake GuildChannel) Guild
-> SnowflakeMap User
-> HashSet (Snowflake Guild)
-> f (BoundedStore Message)
-> Cache f
Cache Maybe User
forall a. Maybe a
Nothing SnowflakeMap Guild
forall a. SnowflakeMap a
SM.empty SnowflakeMap DMChannel
forall a. SnowflakeMap a
SM.empty HashMap (Snowflake GuildChannel) Guild
forall k v. HashMap k v
SH.empty SnowflakeMap User
forall a. SnowflakeMap a
SM.empty HashSet (Snowflake Guild)
forall a. HashSet a
HS.empty (BoundedStore Message -> Identity (BoundedStore Message)
forall a. a -> Identity a
Identity (BoundedStore Message -> Identity (BoundedStore Message))
-> BoundedStore Message -> Identity (BoundedStore Message)
forall a b. (a -> b) -> a -> b
$ Int -> BoundedStore Message
forall a. Int -> BoundedStore a
BS.empty Int
msgLimit)

-- | Run the cache in memory with a default message cache size of 1000
runCacheInMemory :: (P.Member (P.Embed IO) r) => P.Sem (CacheEff ': r) a -> P.Sem r a
runCacheInMemory :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
Sem (CacheEff : r) a -> Sem r a
runCacheInMemory Sem (CacheEff : r) a
m = do
  IORef CacheWithMsg
var <- IO (IORef CacheWithMsg) -> Sem r (IORef CacheWithMsg)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO (IORef CacheWithMsg) -> Sem r (IORef CacheWithMsg))
-> IO (IORef CacheWithMsg) -> Sem r (IORef CacheWithMsg)
forall a b. (a -> b) -> a -> b
$ CacheWithMsg -> IO (IORef CacheWithMsg)
forall a. a -> IO (IORef a)
newIORef CacheWithMsg
emptyCache
  IORef CacheWithMsg
-> Sem (AtomicState CacheWithMsg : r) a -> Sem r a
forall s (r :: EffectRow) a.
Member (Embed IO) r =>
IORef s -> Sem (AtomicState s : r) a -> Sem r a
P.runAtomicStateIORef IORef CacheWithMsg
var (Sem (AtomicState CacheWithMsg : r) a -> Sem r a)
-> Sem (AtomicState CacheWithMsg : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ (forall (rInitial :: EffectRow) x.
 CacheEff (Sem rInitial) x -> Sem (AtomicState CacheWithMsg : r) x)
-> Sem (CacheEff : r) a -> Sem (AtomicState CacheWithMsg : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpret CacheEff (Sem rInitial) x -> Sem (AtomicState CacheWithMsg : r) x
forall (rInitial :: EffectRow) x.
CacheEff (Sem rInitial) x -> Sem (AtomicState CacheWithMsg : r) x
forall {k} (t :: * -> *) (r :: EffectRow) (m :: k) a.
(MessageMod (Cache t), Member (AtomicState (Cache t)) r) =>
CacheEff m a -> Sem r a
runCache' Sem (CacheEff : r) a
m

-- | Run the cache in memory with no messages being cached
runCacheInMemoryNoMsg :: (P.Member (P.Embed IO) r) => P.Sem (CacheEff ': r) a -> P.Sem r a
runCacheInMemoryNoMsg :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
Sem (CacheEff : r) a -> Sem r a
runCacheInMemoryNoMsg Sem (CacheEff : r) a
m = do
  IORef CacheNoMsg
var <- IO (IORef CacheNoMsg) -> Sem r (IORef CacheNoMsg)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO (IORef CacheNoMsg) -> Sem r (IORef CacheNoMsg))
-> IO (IORef CacheNoMsg) -> Sem r (IORef CacheNoMsg)
forall a b. (a -> b) -> a -> b
$ CacheNoMsg -> IO (IORef CacheNoMsg)
forall a. a -> IO (IORef a)
newIORef CacheNoMsg
emptyCacheNoMsg
  IORef CacheNoMsg -> Sem (AtomicState CacheNoMsg : r) a -> Sem r a
forall s (r :: EffectRow) a.
Member (Embed IO) r =>
IORef s -> Sem (AtomicState s : r) a -> Sem r a
P.runAtomicStateIORef IORef CacheNoMsg
var (Sem (AtomicState CacheNoMsg : r) a -> Sem r a)
-> Sem (AtomicState CacheNoMsg : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ (forall (rInitial :: EffectRow) x.
 CacheEff (Sem rInitial) x -> Sem (AtomicState CacheNoMsg : r) x)
-> Sem (CacheEff : r) a -> Sem (AtomicState CacheNoMsg : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpret CacheEff (Sem rInitial) x -> Sem (AtomicState CacheNoMsg : r) x
forall (rInitial :: EffectRow) x.
CacheEff (Sem rInitial) x -> Sem (AtomicState CacheNoMsg : r) x
forall {k} (t :: * -> *) (r :: EffectRow) (m :: k) a.
(MessageMod (Cache t), Member (AtomicState (Cache t)) r) =>
CacheEff m a -> Sem r a
runCache' Sem (CacheEff : r) a
m

-- | Run the cache in memory with a configurable message cache limit
runCacheInMemory' :: (P.Member (P.Embed IO) r) => Int -> P.Sem (CacheEff ': r) a -> P.Sem r a
runCacheInMemory' :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
Int -> Sem (CacheEff : r) a -> Sem r a
runCacheInMemory' Int
msgLimit Sem (CacheEff : r) a
m = do
  IORef CacheWithMsg
var <- IO (IORef CacheWithMsg) -> Sem r (IORef CacheWithMsg)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO (IORef CacheWithMsg) -> Sem r (IORef CacheWithMsg))
-> IO (IORef CacheWithMsg) -> Sem r (IORef CacheWithMsg)
forall a b. (a -> b) -> a -> b
$ CacheWithMsg -> IO (IORef CacheWithMsg)
forall a. a -> IO (IORef a)
newIORef (Int -> CacheWithMsg
emptyCache' Int
msgLimit)
  IORef CacheWithMsg
-> Sem (AtomicState CacheWithMsg : r) a -> Sem r a
forall s (r :: EffectRow) a.
Member (Embed IO) r =>
IORef s -> Sem (AtomicState s : r) a -> Sem r a
P.runAtomicStateIORef IORef CacheWithMsg
var (Sem (AtomicState CacheWithMsg : r) a -> Sem r a)
-> Sem (AtomicState CacheWithMsg : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ (forall (rInitial :: EffectRow) x.
 CacheEff (Sem rInitial) x -> Sem (AtomicState CacheWithMsg : r) x)
-> Sem (CacheEff : r) a -> Sem (AtomicState CacheWithMsg : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpret CacheEff (Sem rInitial) x -> Sem (AtomicState CacheWithMsg : r) x
forall (rInitial :: EffectRow) x.
CacheEff (Sem rInitial) x -> Sem (AtomicState CacheWithMsg : r) x
forall {k} (t :: * -> *) (r :: EffectRow) (m :: k) a.
(MessageMod (Cache t), Member (AtomicState (Cache t)) r) =>
CacheEff m a -> Sem r a
runCache' Sem (CacheEff : r) a
m

runCache' :: (MessageMod (Cache t), P.Member (P.AtomicState (Cache t)) r) => CacheEff m a -> P.Sem r a
runCache' :: forall {k} (t :: * -> *) (r :: EffectRow) (m :: k) a.
(MessageMod (Cache t), Member (AtomicState (Cache t)) r) =>
CacheEff m a -> Sem r a
runCache' CacheEff m a
act = (Cache t -> (Cache t, a)) -> Sem r a
forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
P.atomicState' (((a, Cache t) -> (Cache t, a)
forall a b. (a, b) -> (b, a)
swap ((a, Cache t) -> (Cache t, a))
-> (Cache t -> (a, Cache t)) -> Cache t -> (Cache t, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Cache t -> (a, Cache t)) -> Cache t -> (Cache t, a))
-> (State (Cache t) a -> Cache t -> (a, Cache t))
-> State (Cache t) a
-> Cache t
-> (Cache t, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (Cache t) a -> Cache t -> (a, Cache t)
forall s a. State s a -> s -> (a, s)
runState (State (Cache t) a -> Cache t -> (Cache t, a))
-> State (Cache t) a -> Cache t -> (Cache t, a)
forall a b. (a -> b) -> a -> b
$ CacheEff m a -> State (Cache t) a
forall {k} (t :: * -> *) (m :: k) a.
MessageMod (Cache t) =>
CacheEff m a -> State (Cache t) a
runCache CacheEff m a
act)

class MessageMod t where
  setMessage' :: Message -> State t ()
  getMessage' :: Snowflake Message -> State t (Maybe Message)
  getMessages' :: State t [Message]
  delMessage' :: Snowflake Message -> State t ()

instance MessageMod CacheWithMsg where
  setMessage' :: Message -> State CacheWithMsg ()
setMessage' Message
m = Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
#messages Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
-> Optic
     A_Lens
     NoIx
     (Identity (BoundedStore Message))
     (Identity (BoundedStore Message))
     (BoundedStore Message)
     (BoundedStore Message)
-> Optic
     A_Lens
     NoIx
     CacheWithMsg
     CacheWithMsg
     (BoundedStore Message)
     (BoundedStore Message)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
  (BoundedStore Message)
  (BoundedStore Message)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (BoundedStore Message)
  (BoundedStore Message)
-> (BoundedStore Message -> BoundedStore Message)
-> State CacheWithMsg ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= Message -> BoundedStore Message -> BoundedStore Message
forall a. HasID' a => a -> BoundedStore a -> BoundedStore a
BS.addItem Message
m
  getMessage' :: Snowflake Message -> State CacheWithMsg (Maybe Message)
getMessage' Snowflake Message
mid = Optic' A_Lens NoIx CacheWithMsg (Maybe Message)
-> State CacheWithMsg (Maybe Message)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
#messages Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
-> Optic
     A_Lens
     NoIx
     (Identity (BoundedStore Message))
     (Identity (BoundedStore Message))
     (BoundedStore Message)
     (BoundedStore Message)
-> Optic
     A_Lens
     NoIx
     CacheWithMsg
     CacheWithMsg
     (BoundedStore Message)
     (BoundedStore Message)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
  (BoundedStore Message)
  (BoundedStore Message)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (BoundedStore Message)
  (BoundedStore Message)
-> Optic
     A_Lens
     NoIx
     (BoundedStore Message)
     (BoundedStore Message)
     (Maybe Message)
     (Maybe Message)
-> Optic' A_Lens NoIx CacheWithMsg (Maybe Message)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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)
  getMessages' :: State CacheWithMsg [Message]
getMessages' = BoundedStore Message -> [Message]
forall a. BoundedStore a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (BoundedStore Message -> [Message])
-> StateT CacheWithMsg Identity (BoundedStore Message)
-> State CacheWithMsg [Message]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (BoundedStore Message)
  (BoundedStore Message)
-> StateT CacheWithMsg Identity (BoundedStore Message)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
#messages Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
-> Optic
     A_Lens
     NoIx
     (Identity (BoundedStore Message))
     (Identity (BoundedStore Message))
     (BoundedStore Message)
     (BoundedStore Message)
-> Optic
     A_Lens
     NoIx
     CacheWithMsg
     CacheWithMsg
     (BoundedStore Message)
     (BoundedStore Message)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
  (BoundedStore Message)
  (BoundedStore Message)
forall s t a b. Field1 s t a b => Lens s t a b
_1)
  delMessage' :: Snowflake Message -> State CacheWithMsg ()
delMessage' Snowflake Message
mid = Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
#messages Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
-> Optic
     A_Lens
     NoIx
     (Identity (BoundedStore Message))
     (Identity (BoundedStore Message))
     (BoundedStore Message)
     (BoundedStore Message)
-> Optic
     A_Lens
     NoIx
     CacheWithMsg
     CacheWithMsg
     (BoundedStore Message)
     (BoundedStore Message)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Identity (BoundedStore Message))
  (Identity (BoundedStore Message))
  (BoundedStore Message)
  (BoundedStore Message)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic
  A_Lens
  NoIx
  CacheWithMsg
  CacheWithMsg
  (BoundedStore Message)
  (BoundedStore Message)
-> (BoundedStore Message -> BoundedStore Message)
-> State CacheWithMsg ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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

instance MessageMod CacheNoMsg where
  setMessage' :: Message -> State CacheNoMsg ()
setMessage' !Message
_ = () -> State CacheNoMsg ()
forall a. a -> StateT CacheNoMsg Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  getMessage' :: Snowflake Message -> State CacheNoMsg (Maybe Message)
getMessage' !Snowflake Message
_ = Maybe Message -> State CacheNoMsg (Maybe Message)
forall a. a -> StateT CacheNoMsg Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Message
forall a. Maybe a
Nothing
  getMessages' :: State CacheNoMsg [Message]
getMessages' = [Message] -> State CacheNoMsg [Message]
forall a. a -> StateT CacheNoMsg Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  delMessage' :: Snowflake Message -> State CacheNoMsg ()
delMessage' !Snowflake Message
_ = () -> State CacheNoMsg ()
forall a. a -> StateT CacheNoMsg Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

runCache :: (MessageMod (Cache t)) => CacheEff m a -> State (Cache t) a
runCache :: forall {k} (t :: * -> *) (m :: k) a.
MessageMod (Cache t) =>
CacheEff m a -> State (Cache t) a
runCache (SetBotUser User
u) = Optic A_Lens NoIx (Cache t) (Cache t) (Maybe User) (Maybe User)
#user Optic A_Lens NoIx (Cache t) (Cache t) (Maybe User) (Maybe User)
-> User -> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s (Maybe a) (Maybe b) -> b -> m ()
?= User
u
runCache CacheEff m a
GetBotUser = Optic' A_Lens NoIx (Cache t) a -> StateT (Cache t) Identity a
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens NoIx (Cache t) a
#user
runCache (SetGuild Guild
g) = do
  #guilds %= SM.insert g
  #guildChannels %= SH.filter (\v -> getID @Guild v /= getID @Guild g)
  #guildChannels %= SH.union (SH.fromList $ map (,g) (SM.keys (g ^. #channels)))
runCache (GetGuild Snowflake Guild
gid) = Optic' A_Lens NoIx (Cache t) a -> StateT (Cache t) Identity a
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap Guild)
  (SnowflakeMap Guild)
#guilds Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap Guild)
  (SnowflakeMap Guild)
-> Optic A_Lens NoIx (SnowflakeMap Guild) (SnowflakeMap Guild) a a
-> Optic' A_Lens NoIx (Cache t) a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 (GetGuildChannel Snowflake GuildChannel
cid) = Optic'
  A_Lens
  NoIx
  (Cache t)
  (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
-> StateT
     (Cache t)
     Identity
     (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashMap (Snowflake GuildChannel) Guild)
  (HashMap (Snowflake GuildChannel) Guild)
#guildChannels Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashMap (Snowflake GuildChannel) Guild)
  (HashMap (Snowflake GuildChannel) Guild)
-> Optic
     A_Lens
     NoIx
     (HashMap (Snowflake GuildChannel) Guild)
     (HashMap (Snowflake GuildChannel) Guild)
     (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
     (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
-> Optic'
     A_Lens
     NoIx
     (Cache t)
     (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (HashMap (Snowflake GuildChannel) Guild)
-> Optic
     A_Lens
     NoIx
     (HashMap (Snowflake GuildChannel) Guild)
     (HashMap (Snowflake GuildChannel) Guild)
     (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
     (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at' Index (HashMap (Snowflake GuildChannel) Guild)
Snowflake GuildChannel
cid) StateT
  (Cache t)
  Identity
  (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)))
-> (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild)) -> a)
-> StateT (Cache t) Identity a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe (IxValue (HashMap (Snowflake GuildChannel) Guild))
-> (IxValue (HashMap (Snowflake GuildChannel) Guild)
    -> Maybe GuildChannel)
-> Maybe GuildChannel
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IxValue (HashMap (Snowflake GuildChannel) Guild)
-> Optic'
     A_Lens
     NoIx
     (IxValue (HashMap (Snowflake GuildChannel) Guild))
     (Maybe GuildChannel)
-> Maybe GuildChannel
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (IxValue (HashMap (Snowflake GuildChannel) Guild))
  (IxValue (HashMap (Snowflake GuildChannel) Guild))
  (SnowflakeMap GuildChannel)
  (SnowflakeMap GuildChannel)
#channels Optic
  A_Lens
  NoIx
  (IxValue (HashMap (Snowflake GuildChannel) Guild))
  (IxValue (HashMap (Snowflake GuildChannel) Guild))
  (SnowflakeMap GuildChannel)
  (SnowflakeMap GuildChannel)
-> Optic
     A_Lens
     NoIx
     (SnowflakeMap GuildChannel)
     (SnowflakeMap GuildChannel)
     (Maybe GuildChannel)
     (Maybe GuildChannel)
-> Optic'
     A_Lens
     NoIx
     (IxValue (HashMap (Snowflake GuildChannel) Guild))
     (Maybe GuildChannel)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (SnowflakeMap GuildChannel)
-> Lens'
     (SnowflakeMap GuildChannel)
     (Maybe (IxValue (SnowflakeMap GuildChannel)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at' Index (SnowflakeMap GuildChannel)
Snowflake GuildChannel
cid))
runCache CacheEff m a
GetGuilds = SnowflakeMap Guild -> a
SnowflakeMap Guild -> [Guild]
forall a. SnowflakeMap a -> [a]
SM.elems (SnowflakeMap Guild -> a)
-> StateT (Cache t) Identity (SnowflakeMap Guild)
-> StateT (Cache t) Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap Guild)
  (SnowflakeMap Guild)
-> StateT (Cache t) Identity (SnowflakeMap Guild)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap Guild)
  (SnowflakeMap Guild)
#guilds
runCache (DelGuild Snowflake Guild
gid) = do
  #guilds %= sans gid
  #guildChannels %= SH.filter (\v -> getID @Guild v /= gid)
runCache (SetDM DMChannel
dm) = Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
#dms Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
-> (SnowflakeMap DMChannel -> SnowflakeMap DMChannel)
-> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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 Snowflake DMChannel
did) = Optic' A_Lens NoIx (Cache t) a -> StateT (Cache t) Identity a
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
#dms Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
-> Optic
     A_Lens NoIx (SnowflakeMap DMChannel) (SnowflakeMap DMChannel) a a
-> Optic' A_Lens NoIx (Cache t) a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 CacheEff m a
GetDMs = SnowflakeMap DMChannel -> a
SnowflakeMap DMChannel -> [DMChannel]
forall a. SnowflakeMap a -> [a]
SM.elems (SnowflakeMap DMChannel -> a)
-> StateT (Cache t) Identity (SnowflakeMap DMChannel)
-> StateT (Cache t) Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
-> StateT (Cache t) Identity (SnowflakeMap DMChannel)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
#dms
runCache (DelDM Snowflake DMChannel
did) = Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
#dms Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap DMChannel)
  (SnowflakeMap DMChannel)
-> (SnowflakeMap DMChannel -> SnowflakeMap DMChannel)
-> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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 User
u) = Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
#users Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
-> (SnowflakeMap User -> SnowflakeMap User)
-> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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 Snowflake User
uid) = Optic' A_Lens NoIx (Cache t) a -> StateT (Cache t) Identity a
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
#users Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
-> Optic A_Lens NoIx (SnowflakeMap User) (SnowflakeMap User) a a
-> Optic' A_Lens NoIx (Cache t) a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 CacheEff m a
GetUsers = SnowflakeMap User -> a
SnowflakeMap User -> [User]
forall a. SnowflakeMap a -> [a]
SM.elems (SnowflakeMap User -> a)
-> StateT (Cache t) Identity (SnowflakeMap User)
-> StateT (Cache t) Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
-> StateT (Cache t) Identity (SnowflakeMap User)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
#users
runCache (DelUser Snowflake User
uid) = Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
#users Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (SnowflakeMap User)
  (SnowflakeMap User)
-> (SnowflakeMap User -> SnowflakeMap User)
-> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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 Snowflake Guild
gid) = Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
#unavailableGuilds Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
-> (HashSet (Snowflake Guild) -> HashSet (Snowflake Guild))
-> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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
HS.insert Snowflake Guild
gid
runCache (IsUnavailableGuild Snowflake Guild
gid) = Optic' A_Lens NoIx (Cache t) a -> StateT (Cache t) Identity a
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
#unavailableGuilds Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
-> Optic
     A_Lens
     NoIx
     (HashSet (Snowflake Guild))
     (HashSet (Snowflake Guild))
     a
     a
-> Optic' A_Lens NoIx (Cache t) a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 CacheEff m a
GetUnavailableGuilds = HashSet (Snowflake Guild) -> a
HashSet (Snowflake Guild) -> [Snowflake Guild]
forall a. HashSet a -> [a]
HS.toList (HashSet (Snowflake Guild) -> a)
-> StateT (Cache t) Identity (HashSet (Snowflake Guild))
-> StateT (Cache t) Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
-> StateT (Cache t) Identity (HashSet (Snowflake Guild))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
#unavailableGuilds
runCache (DelUnavailableGuild Snowflake Guild
gid) = Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
#unavailableGuilds Optic
  A_Lens
  NoIx
  (Cache t)
  (Cache t)
  (HashSet (Snowflake Guild))
  (HashSet (Snowflake Guild))
-> (HashSet (Snowflake Guild) -> HashSet (Snowflake Guild))
-> StateT (Cache t) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is 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 Message
m) = Message -> StateT (Cache t) Identity ()
forall t. MessageMod t => Message -> State t ()
setMessage' Message
m
runCache (GetMessage Snowflake Message
mid) = Snowflake Message -> State (Cache t) (Maybe Message)
forall t.
MessageMod t =>
Snowflake Message -> State t (Maybe Message)
getMessage' Snowflake Message
mid
runCache CacheEff m a
GetMessages = StateT (Cache t) Identity a
State (Cache t) [Message]
forall t. MessageMod t => State t [Message]
getMessages'
runCache (DelMessage Snowflake Message
mid) = Snowflake Message -> StateT (Cache t) Identity ()
forall t. MessageMod t => Snowflake Message -> State t ()
delMessage' Snowflake Message
mid