-- | A thing for storing the last N messages
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 #-}