{-# LANGUAGE TemplateHaskell #-}

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

import Calamity.Internal.Utils ( unlessM, whenM )
import Calamity.Types.Snowflake ( HasID(getID), Snowflake, HasID' )
import Control.Monad.State.Lazy ( when, execState )
import Data.Default.Class ( Default(..) )
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Deque.Lazy (Deque)
import qualified Deque.Lazy as DQ
import Optics
import Optics.State.Operators ((%=), (.=))

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)

$(makeFieldLabelsNoPrefix ''BoundedStore)

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 = LensVL (BoundedStore a) (BoundedStore a) (Maybe a) (Maybe a)
-> Lens (BoundedStore a) (BoundedStore a) (Maybe a) (Maybe a)
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (BoundedStore a) (BoundedStore a) (Maybe a) (Maybe a)
 -> Lens (BoundedStore a) (BoundedStore a) (Maybe a) (Maybe a))
-> LensVL (BoundedStore a) (BoundedStore a) (Maybe a) (Maybe a)
-> Lens (BoundedStore a) (BoundedStore a) (Maybe a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Maybe a -> f (Maybe a)
f BoundedStore a
m ->
    let 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
     in Maybe a -> f (Maybe a)
f Maybe 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 v -> a -> BoundedStore a -> BoundedStore a
forall a. HasID' a => a -> BoundedStore a -> BoundedStore a
addItem a
v 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
<$> Optic' A_Lens NoIx (BoundedStore a) (HashMap (Snowflake a) a)
-> StateT (BoundedStore a) Identity (HashMap (Snowflake a) a)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use IsLabel
  "items"
  (Optic' A_Lens NoIx (BoundedStore a) (HashMap (Snowflake a) a))
Optic' A_Lens NoIx (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 %= succ

  Int
size <- Optic A_Lens NoIx (BoundedStore a) (BoundedStore a) Int Int
-> StateT (BoundedStore a) Identity Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use IsLabel
  "size"
  (Optic A_Lens NoIx (BoundedStore a) (BoundedStore a) Int Int)
Optic A_Lens NoIx (BoundedStore a) (BoundedStore a) Int Int
#size
  Int
limit <- Optic A_Lens NoIx (BoundedStore a) (BoundedStore a) Int Int
-> StateT (BoundedStore a) Identity Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use IsLabel
  "limit"
  (Optic A_Lens NoIx (BoundedStore a) (BoundedStore a) Int Int)
Optic A_Lens NoIx (BoundedStore a) (BoundedStore a) Int 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 <- Optic
  A_Lens
  NoIx
  (BoundedStore a)
  (BoundedStore a)
  (Deque (Snowflake a))
  (Deque (Snowflake a))
-> StateT (BoundedStore a) Identity (Deque (Snowflake a))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use IsLabel
  "itemQueue"
  (Optic
     A_Lens
     NoIx
     (BoundedStore a)
     (BoundedStore a)
     (Deque (Snowflake a))
     (Deque (Snowflake a)))
Optic
  A_Lens
  NoIx
  (BoundedStore a)
  (BoundedStore a)
  (Deque (Snowflake 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 %= pred

  #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
-> Optic' A_Lens NoIx (BoundedStore a) (HashMap (Snowflake a) a)
-> HashMap (Snowflake a) a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "items"
  (Optic' A_Lens NoIx (BoundedStore a) (HashMap (Snowflake a) a))
Optic' A_Lens NoIx (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
<$> Optic' A_Lens NoIx (BoundedStore a) (HashMap (Snowflake a) a)
-> StateT (BoundedStore a) Identity (HashMap (Snowflake a) a)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use IsLabel
  "items"
  (Optic' A_Lens NoIx (BoundedStore a) (HashMap (Snowflake a) a))
Optic' A_Lens NoIx (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 %= pred

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