module Network.HTTP2.Priority.Queue (
    Precedence(..)
  , TPriorityQueue
  , new
  , isEmpty
  , enqueue
  , dequeue
  , delete
  ) where

import Control.Concurrent.STM
import Network.HTTP2.Priority.PSQ (PriorityQueue, Key, Precedence(..))
import qualified Network.HTTP2.Priority.PSQ as Q

----------------------------------------------------------------

newtype TPriorityQueue a = TPriorityQueue (TVar (PriorityQueue a))

new :: STM (TPriorityQueue a)
new :: STM (TPriorityQueue a)
new = TVar (PriorityQueue a) -> TPriorityQueue a
forall a. TVar (PriorityQueue a) -> TPriorityQueue a
TPriorityQueue (TVar (PriorityQueue a) -> TPriorityQueue a)
-> STM (TVar (PriorityQueue a)) -> STM (TPriorityQueue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PriorityQueue a -> STM (TVar (PriorityQueue a))
forall a. a -> STM (TVar a)
newTVar PriorityQueue a
forall a. PriorityQueue a
Q.empty

isEmpty :: TPriorityQueue a -> STM Bool
isEmpty :: TPriorityQueue a -> STM Bool
isEmpty (TPriorityQueue TVar (PriorityQueue a)
th) = PriorityQueue a -> Bool
forall a. PriorityQueue a -> Bool
Q.isEmpty (PriorityQueue a -> Bool) -> STM (PriorityQueue a) -> STM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (PriorityQueue a) -> STM (PriorityQueue a)
forall a. TVar a -> STM a
readTVar TVar (PriorityQueue a)
th

enqueue :: TPriorityQueue a -> Key -> Precedence -> a -> STM ()
enqueue :: TPriorityQueue a -> Key -> Precedence -> a -> STM ()
enqueue (TPriorityQueue TVar (PriorityQueue a)
th) Key
k Precedence
p a
v = TVar (PriorityQueue a)
-> (PriorityQueue a -> PriorityQueue a) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (PriorityQueue a)
th ((PriorityQueue a -> PriorityQueue a) -> STM ())
-> (PriorityQueue a -> PriorityQueue a) -> STM ()
forall a b. (a -> b) -> a -> b
$ Key -> Precedence -> a -> PriorityQueue a -> PriorityQueue a
forall a.
Key -> Precedence -> a -> PriorityQueue a -> PriorityQueue a
Q.enqueue Key
k Precedence
p a
v

dequeue :: TPriorityQueue a -> STM (Key, Precedence, a)
dequeue :: TPriorityQueue a -> STM (Key, Precedence, a)
dequeue (TPriorityQueue TVar (PriorityQueue a)
th) = do
  PriorityQueue a
h <- TVar (PriorityQueue a) -> STM (PriorityQueue a)
forall a. TVar a -> STM a
readTVar TVar (PriorityQueue a)
th
  case PriorityQueue a -> Maybe (Key, Precedence, a, PriorityQueue a)
forall a.
PriorityQueue a -> Maybe (Key, Precedence, a, PriorityQueue a)
Q.dequeue PriorityQueue a
h of
    Maybe (Key, Precedence, a, PriorityQueue a)
Nothing -> STM (Key, Precedence, a)
forall a. STM a
retry
    Just (Key
k, Precedence
p, a
v, PriorityQueue a
h') -> do
      TVar (PriorityQueue a) -> PriorityQueue a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (PriorityQueue a)
th PriorityQueue a
h'
      (Key, Precedence, a) -> STM (Key, Precedence, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
k, Precedence
p, a
v)

delete :: Key -> TPriorityQueue a -> STM (Maybe a)
delete :: Key -> TPriorityQueue a -> STM (Maybe a)
delete Key
k (TPriorityQueue TVar (PriorityQueue a)
th) = do
    PriorityQueue a
q <- TVar (PriorityQueue a) -> STM (PriorityQueue a)
forall a. TVar a -> STM a
readTVar TVar (PriorityQueue a)
th
    let (Maybe a
mv, PriorityQueue a
q') = Key -> PriorityQueue a -> (Maybe a, PriorityQueue a)
forall a. Key -> PriorityQueue a -> (Maybe a, PriorityQueue a)
Q.delete Key
k PriorityQueue a
q
    TVar (PriorityQueue a) -> PriorityQueue a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (PriorityQueue a)
th PriorityQueue a
q'
    Maybe a -> STM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
mv