-- | A thing for storing the last N things with IDs
module Calamity.Internal.BoundedStore (
  BoundedStore,
  empty,
  addItem,
  getItem,
  dropItem,
) where

import Calamity.Internal.Utils
import Calamity.Types.Snowflake
import Control.Lens
import Control.Monad.State.Lazy
import Data.Default.Class
import Data.Generics.Labels ()
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Deque.Lazy (Deque)
import qualified Deque.Lazy as DQ
import GHC.Generics

data BoundedStore a = BoundedStore
  { BoundedStore a -> Deque (Snowflake a)
itemQueue :: Deque (Snowflake a)
  , BoundedStore a -> HashMap (Snowflake a) a
items :: HashMap (Snowflake a) a
  , BoundedStore a -> Int
limit :: Int
  , BoundedStore a -> Int
size :: Int
  }
  deriving (Int -> BoundedStore a -> ShowS
[BoundedStore a] -> ShowS
BoundedStore a -> String
(Int -> BoundedStore a -> ShowS)
-> (BoundedStore a -> String)
-> ([BoundedStore a] -> ShowS)
-> Show (BoundedStore a)
forall a. Show a => Int -> BoundedStore a -> ShowS
forall a. Show a => [BoundedStore a] -> ShowS
forall a. Show a => BoundedStore a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoundedStore a] -> ShowS
$cshowList :: forall a. Show a => [BoundedStore a] -> ShowS
show :: BoundedStore a -> String
$cshow :: forall a. Show a => BoundedStore a -> String
showsPrec :: Int -> BoundedStore a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BoundedStore a -> ShowS
Show, (forall x. BoundedStore a -> Rep (BoundedStore a) x)
-> (forall x. Rep (BoundedStore a) x -> BoundedStore a)
-> Generic (BoundedStore a)
forall x. Rep (BoundedStore a) x -> BoundedStore a
forall x. BoundedStore a -> Rep (BoundedStore a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BoundedStore a) x -> BoundedStore a
forall a x. BoundedStore a -> Rep (BoundedStore a) x
$cto :: forall a x. Rep (BoundedStore a) x -> BoundedStore a
$cfrom :: forall a x. BoundedStore a -> Rep (BoundedStore a) x
Generic)

instance Foldable BoundedStore where
  foldr :: (a -> b -> b) -> b -> BoundedStore a -> b
foldr a -> b -> b
f b
i = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
i ([a] -> b) -> (BoundedStore a -> [a]) -> BoundedStore a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (Snowflake a) a -> [a]
forall k v. HashMap k v -> [v]
H.elems (HashMap (Snowflake a) a -> [a])
-> (BoundedStore a -> HashMap (Snowflake a) a)
-> BoundedStore a
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedStore a -> HashMap (Snowflake a) a
forall a. BoundedStore a -> HashMap (Snowflake a) a
items

instance Default (BoundedStore a) where
  def :: BoundedStore a
def = Deque (Snowflake a)
-> HashMap (Snowflake a) a -> Int -> Int -> BoundedStore a
forall a.
Deque (Snowflake a)
-> HashMap (Snowflake a) a -> Int -> Int -> BoundedStore a
BoundedStore Deque (Snowflake a)
forall a. Monoid a => a
mempty HashMap (Snowflake a) a
forall a. Monoid a => a
mempty Int
1000 Int
0

empty :: Int -> BoundedStore a
empty :: Int -> BoundedStore a
empty Int
limit = Deque (Snowflake a)
-> HashMap (Snowflake a) a -> Int -> Int -> BoundedStore a
forall a.
Deque (Snowflake a)
-> HashMap (Snowflake a) a -> Int -> Int -> BoundedStore a
BoundedStore Deque (Snowflake a)
forall a. Monoid a => a
mempty HashMap (Snowflake a) a
forall a. Monoid a => a
mempty Int
limit Int
0

type instance Index (BoundedStore a) = Snowflake a

type instance IxValue (BoundedStore a) = a

instance HasID' a => Ixed (BoundedStore a)

instance HasID' a => At (BoundedStore a) where
  at :: Index (BoundedStore a)
-> Lens' (BoundedStore a) (Maybe (IxValue (BoundedStore a)))
at Index (BoundedStore a)
k Maybe (IxValue (BoundedStore a))
-> f (Maybe (IxValue (BoundedStore a)))
f BoundedStore a
m =
    Maybe (IxValue (BoundedStore a))
-> f (Maybe (IxValue (BoundedStore a)))
f Maybe a
Maybe (IxValue (BoundedStore a))
mv f (Maybe a) -> (Maybe a -> BoundedStore a) -> f (BoundedStore a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe a
Nothing -> BoundedStore a
-> (a -> BoundedStore a) -> Maybe a -> BoundedStore a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BoundedStore a
m (BoundedStore a -> a -> BoundedStore a
forall a b. a -> b -> a
const (Snowflake a -> BoundedStore a -> BoundedStore a
forall a. Snowflake a -> BoundedStore a -> BoundedStore a
dropItem Index (BoundedStore a)
Snowflake a
k BoundedStore a
m)) Maybe a
mv
      Just a
v -> a -> BoundedStore a -> BoundedStore a
forall a. HasID' a => a -> BoundedStore a -> BoundedStore a
addItem a
v BoundedStore a
m
   where
    mv :: Maybe a
mv = Snowflake a -> BoundedStore a -> Maybe a
forall a. Snowflake a -> BoundedStore a -> Maybe a
getItem Index (BoundedStore a)
Snowflake a
k BoundedStore a
m
  {-# INLINE at #-}

addItem :: HasID' a => a -> BoundedStore a -> BoundedStore a
addItem :: a -> BoundedStore a -> BoundedStore a
addItem a
m = State (BoundedStore a) () -> BoundedStore a -> BoundedStore a
forall s a. State s a -> s -> s
execState (State (BoundedStore a) () -> BoundedStore a -> BoundedStore a)
-> State (BoundedStore a) () -> BoundedStore a -> BoundedStore a
forall a b. (a -> b) -> a -> b
$ do
  StateT (BoundedStore a) Identity Bool
-> State (BoundedStore a) () -> State (BoundedStore a) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Snowflake a -> HashMap (Snowflake a) a -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member (a -> Snowflake a
forall b a. HasID b a => a -> Snowflake b
getID a
m) (HashMap (Snowflake a) a -> Bool)
-> StateT (BoundedStore a) Identity (HashMap (Snowflake a) a)
-> StateT (BoundedStore a) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (HashMap (Snowflake a) a)
  (BoundedStore a)
  (HashMap (Snowflake a) a)
-> StateT (BoundedStore a) Identity (HashMap (Snowflake a) a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
  "items"
  (Getting
     (HashMap (Snowflake a) a)
     (BoundedStore a)
     (HashMap (Snowflake a) a))
Getting
  (HashMap (Snowflake a) a)
  (BoundedStore a)
  (HashMap (Snowflake a) a)
#items) (State (BoundedStore a) () -> State (BoundedStore a) ())
-> State (BoundedStore a) () -> State (BoundedStore a) ()
forall a b. (a -> b) -> a -> b
$ do
    #itemQueue %= DQ.cons (getID m)
    #size += 1

  Int
size <- Getting Int (BoundedStore a) Int
-> StateT (BoundedStore a) Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel "size" (Getting Int (BoundedStore a) Int)
Getting Int (BoundedStore a) Int
#size
  Int
limit <- Getting Int (BoundedStore a) Int
-> StateT (BoundedStore a) Identity Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel "limit" (Getting Int (BoundedStore a) Int)
Getting Int (BoundedStore a) Int
#limit

  Bool -> State (BoundedStore a) () -> State (BoundedStore a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit) (State (BoundedStore a) () -> State (BoundedStore a) ())
-> State (BoundedStore a) () -> State (BoundedStore a) ()
forall a b. (a -> b) -> a -> b
$ do
    Deque (Snowflake a)
q <- Getting
  (Deque (Snowflake a)) (BoundedStore a) (Deque (Snowflake a))
-> StateT (BoundedStore a) Identity (Deque (Snowflake a))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
  "itemQueue"
  (Getting
     (Deque (Snowflake a)) (BoundedStore a) (Deque (Snowflake a)))
Getting
  (Deque (Snowflake a)) (BoundedStore a) (Deque (Snowflake a))
#itemQueue
    let Just (Snowflake a
rid, Deque (Snowflake a)
q') = Deque (Snowflake a) -> Maybe (Snowflake a, Deque (Snowflake a))
forall a. Deque a -> Maybe (a, Deque a)
DQ.unsnoc Deque (Snowflake a)
q
    #itemQueue .= q'
    #items %= sans rid
    #size -= 1

  #items %= H.insert (getID m) m
{-# INLINE addItem #-}

getItem :: Snowflake a -> BoundedStore a -> Maybe a
getItem :: Snowflake a -> BoundedStore a -> Maybe a
getItem Snowflake a
id BoundedStore a
s = Snowflake a -> HashMap (Snowflake a) a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Snowflake a
id (BoundedStore a
s BoundedStore a
-> Getting
     (HashMap (Snowflake a) a)
     (BoundedStore a)
     (HashMap (Snowflake a) a)
-> HashMap (Snowflake a) a
forall s a. s -> Getting a s a -> a
^. IsLabel
  "items"
  (Getting
     (HashMap (Snowflake a) a)
     (BoundedStore a)
     (HashMap (Snowflake a) a))
Getting
  (HashMap (Snowflake a) a)
  (BoundedStore a)
  (HashMap (Snowflake a) a)
#items)
{-# INLINE getItem #-}

dropItem :: Snowflake a -> BoundedStore a -> BoundedStore a
dropItem :: Snowflake a -> BoundedStore a -> BoundedStore a
dropItem Snowflake a
id = State (BoundedStore a) () -> BoundedStore a -> BoundedStore a
forall s a. State s a -> s -> s
execState (State (BoundedStore a) () -> BoundedStore a -> BoundedStore a)
-> State (BoundedStore a) () -> BoundedStore a -> BoundedStore a
forall a b. (a -> b) -> a -> b
$ do
  StateT (BoundedStore a) Identity Bool
-> State (BoundedStore a) () -> State (BoundedStore a) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Snowflake a -> HashMap (Snowflake a) a -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Snowflake a
id (HashMap (Snowflake a) a -> Bool)
-> StateT (BoundedStore a) Identity (HashMap (Snowflake a) a)
-> StateT (BoundedStore a) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (HashMap (Snowflake a) a)
  (BoundedStore a)
  (HashMap (Snowflake a) a)
-> StateT (BoundedStore a) Identity (HashMap (Snowflake a) a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use IsLabel
  "items"
  (Getting
     (HashMap (Snowflake a) a)
     (BoundedStore a)
     (HashMap (Snowflake a) a))
Getting
  (HashMap (Snowflake a) a)
  (BoundedStore a)
  (HashMap (Snowflake a) a)
#items) (State (BoundedStore a) () -> State (BoundedStore a) ())
-> State (BoundedStore a) () -> State (BoundedStore a) ()
forall a b. (a -> b) -> a -> b
$ do
    #size -= 1

  #itemQueue %= DQ.filter (/= id)
  #items %= H.delete id
{-# INLINE dropItem #-}