module Calamity.Internal.MessageStore
( MessageStore(..)
, addMessage
, getMessage
, dropMessage ) where
import Calamity.Internal.Utils
import Calamity.Types.Model.Channel.Message
import Calamity.Types.Snowflake
import Control.Lens
import Control.Lens.Operators ( (.=) )
import Control.Monad.State.Lazy
import Data.Default.Class
import Data.Generics.Labels ()
import Data.HashMap.Lazy ( HashMap )
import qualified Data.HashMap.Lazy as H
import qualified Deque.Lazy as DQ
import Deque.Lazy ( Deque )
import GHC.Generics
data MessageStore = MessageStore
{ MessageStore -> Deque (Snowflake Message)
messageQueue :: Deque (Snowflake Message)
, MessageStore -> HashMap (Snowflake Message) Message
messages :: HashMap (Snowflake Message) Message
, MessageStore -> Int
limit :: Int
, MessageStore -> Int
size :: Int
}
deriving ( Int -> MessageStore -> ShowS
[MessageStore] -> ShowS
MessageStore -> String
(Int -> MessageStore -> ShowS)
-> (MessageStore -> String)
-> ([MessageStore] -> ShowS)
-> Show MessageStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageStore] -> ShowS
$cshowList :: [MessageStore] -> ShowS
show :: MessageStore -> String
$cshow :: MessageStore -> String
showsPrec :: Int -> MessageStore -> ShowS
$cshowsPrec :: Int -> MessageStore -> ShowS
Show, (forall x. MessageStore -> Rep MessageStore x)
-> (forall x. Rep MessageStore x -> MessageStore)
-> Generic MessageStore
forall x. Rep MessageStore x -> MessageStore
forall x. MessageStore -> Rep MessageStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageStore x -> MessageStore
$cfrom :: forall x. MessageStore -> Rep MessageStore x
Generic )
instance Default MessageStore where
def :: MessageStore
def = Deque (Snowflake Message)
-> HashMap (Snowflake Message) Message
-> Int
-> Int
-> MessageStore
MessageStore Deque (Snowflake Message)
forall a. Monoid a => a
mempty HashMap (Snowflake Message) Message
forall k v. HashMap k v
H.empty 1000 0
type instance (Index MessageStore) = Snowflake Message
type instance (IxValue MessageStore) = Message
instance Ixed MessageStore
instance At MessageStore where
at :: Index MessageStore
-> Lens' MessageStore (Maybe (IxValue MessageStore))
at k :: Index MessageStore
k f :: Maybe (IxValue MessageStore) -> f (Maybe (IxValue MessageStore))
f m :: MessageStore
m = Maybe (IxValue MessageStore) -> f (Maybe (IxValue MessageStore))
f Maybe (IxValue MessageStore)
Maybe Message
mv f (Maybe Message)
-> (Maybe Message -> MessageStore) -> f MessageStore
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Nothing -> MessageStore
-> (Message -> MessageStore) -> Maybe Message -> MessageStore
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MessageStore
m (MessageStore -> Message -> MessageStore
forall a b. a -> b -> a
const (Snowflake Message -> MessageStore -> MessageStore
dropMessage Index MessageStore
Snowflake Message
k MessageStore
m)) Maybe Message
mv
Just v :: Message
v -> Message -> MessageStore -> MessageStore
addMessage Message
v MessageStore
m
where
mv :: Maybe Message
mv = Snowflake Message -> MessageStore -> Maybe Message
getMessage Index MessageStore
Snowflake Message
k MessageStore
m
{-# INLINE at #-}
addMessage :: Message -> MessageStore -> MessageStore
addMessage :: Message -> MessageStore -> MessageStore
addMessage m :: Message
m = State MessageStore () -> MessageStore -> MessageStore
forall s a. State s a -> s -> s
execState (State MessageStore () -> MessageStore -> MessageStore)
-> State MessageStore () -> MessageStore -> MessageStore
forall a b. (a -> b) -> a -> b
$ do
StateT MessageStore Identity Bool
-> State MessageStore () -> State MessageStore ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Snowflake Message -> HashMap (Snowflake Message) Message -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (Message
m Message
-> Getting (Snowflake Message) Message (Snowflake Message)
-> Snowflake Message
forall s a. s -> Getting a s a -> a
^. IsLabel
"id" (Getting (Snowflake Message) Message (Snowflake Message))
Getting (Snowflake Message) Message (Snowflake Message)
#id) (HashMap (Snowflake Message) Message -> Bool)
-> StateT
MessageStore Identity (HashMap (Snowflake Message) Message)
-> StateT MessageStore Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message)
-> StateT
MessageStore Identity (HashMap (Snowflake Message) Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"messages"
(Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message))
Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message)
#messages) do
#messageQueue %= DQ.cons (getID m)
#size += 1
Int
size <- Getting Int MessageStore Int -> StateT MessageStore Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel "size" (Getting Int MessageStore Int)
Getting Int MessageStore Int
#size
Int
limit <- Getting Int MessageStore Int -> StateT MessageStore Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel "limit" (Getting Int MessageStore Int)
Getting Int MessageStore Int
#limit
Bool -> State MessageStore () -> State MessageStore ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit) do
Deque (Snowflake Message)
q <- Getting
(Deque (Snowflake Message))
MessageStore
(Deque (Snowflake Message))
-> StateT MessageStore Identity (Deque (Snowflake Message))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"messageQueue"
(Getting
(Deque (Snowflake Message))
MessageStore
(Deque (Snowflake Message)))
Getting
(Deque (Snowflake Message))
MessageStore
(Deque (Snowflake Message))
#messageQueue
let Just (rid :: Snowflake Message
rid, q' :: Deque (Snowflake Message)
q') = Deque (Snowflake Message)
-> Maybe (Snowflake Message, Deque (Snowflake Message))
forall a. Deque a -> Maybe (a, Deque a)
DQ.unsnoc Deque (Snowflake Message)
q
#messageQueue .= q'
#messages %= sans rid
#size -= 1
#messages %= H.insert (getID m) m
{-# INLINE addMessage #-}
getMessage :: Snowflake Message -> MessageStore -> Maybe Message
getMessage :: Snowflake Message -> MessageStore -> Maybe Message
getMessage id :: Snowflake Message
id s :: MessageStore
s = Snowflake Message
-> HashMap (Snowflake Message) Message -> Maybe Message
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Snowflake Message
id (MessageStore
s MessageStore
-> Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message)
-> HashMap (Snowflake Message) Message
forall s a. s -> Getting a s a -> a
^. IsLabel
"messages"
(Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message))
Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message)
#messages)
{-# INLINE getMessage #-}
dropMessage :: Snowflake Message -> MessageStore -> MessageStore
dropMessage :: Snowflake Message -> MessageStore -> MessageStore
dropMessage id :: Snowflake Message
id = State MessageStore () -> MessageStore -> MessageStore
forall s a. State s a -> s -> s
execState (State MessageStore () -> MessageStore -> MessageStore)
-> State MessageStore () -> MessageStore -> MessageStore
forall a b. (a -> b) -> a -> b
$ do
StateT MessageStore Identity Bool
-> State MessageStore () -> State MessageStore ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Snowflake Message -> HashMap (Snowflake Message) Message -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Snowflake Message
id (HashMap (Snowflake Message) Message -> Bool)
-> StateT
MessageStore Identity (HashMap (Snowflake Message) Message)
-> StateT MessageStore Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message)
-> StateT
MessageStore Identity (HashMap (Snowflake Message) Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
"messages"
(Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message))
Getting
(HashMap (Snowflake Message) Message)
MessageStore
(HashMap (Snowflake Message) Message)
#messages) do
#size -= 1
#messageQueue %= DQ.filter (/= id)
#messages %= H.delete id
{-# INLINE dropMessage #-}