{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.Priority.PSQ (
Key
, Weight
, Deficit
, Precedence(..)
, newPrecedence
, PriorityQueue(..)
, Heap
, empty
, isEmpty
, enqueue
, dequeue
, delete
) where
import Data.Array (Array, listArray, (!))
import Data.IntPSQ (IntPSQ)
import qualified Data.IntPSQ as P
type Key = Int
type Weight = Int
type Deficit = Word
data Precedence = Precedence {
Precedence -> Word
deficit :: Deficit
, Precedence -> Int
weight :: Weight
, Precedence -> Int
dependency :: Key
} deriving Int -> Precedence -> ShowS
[Precedence] -> ShowS
Precedence -> String
(Int -> Precedence -> ShowS)
-> (Precedence -> String)
-> ([Precedence] -> ShowS)
-> Show Precedence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Precedence -> ShowS
showsPrec :: Int -> Precedence -> ShowS
$cshow :: Precedence -> String
show :: Precedence -> String
$cshowList :: [Precedence] -> ShowS
showList :: [Precedence] -> ShowS
Show
newPrecedence :: Weight -> Precedence
newPrecedence :: Int -> Precedence
newPrecedence Int
w = Word -> Int -> Int -> Precedence
Precedence Word
0 Int
w Int
0
instance Eq Precedence where
Precedence Word
d1 Int
_ Int
_ == :: Precedence -> Precedence -> Bool
== Precedence Word
d2 Int
_ Int
_ = Word
d1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
d2
instance Ord Precedence where
Precedence Word
d1 Int
_ Int
_ < :: Precedence -> Precedence -> Bool
< Precedence Word
d2 Int
_ Int
_ = Word
d1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
d2 Bool -> Bool -> Bool
&& Word
d2 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
d1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
deficitStepsW
Precedence Word
d1 Int
_ Int
_ <= :: Precedence -> Precedence -> Bool
<= Precedence Word
d2 Int
_ Int
_ = Word
d2 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
d1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
deficitStepsW
type Heap a = IntPSQ Precedence a
data PriorityQueue a = PriorityQueue {
forall a. PriorityQueue a -> Word
baseDeficit :: Deficit
, forall a. PriorityQueue a -> Heap a
queue :: Heap a
}
deficitSteps :: Int
deficitSteps :: Int
deficitSteps = Int
65536
deficitStepsW :: Word
deficitStepsW :: Word
deficitStepsW = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
deficitSteps
deficitList :: [Deficit]
deficitList :: [Word]
deficitList = (Double -> Word) -> [Double] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Word
forall {a} {b}. (RealFrac a, Integral b) => a -> b
calc [Double]
idxs
where
idxs :: [Double]
idxs = [Double
1..Double
256] :: [Double]
calc :: a -> b
calc a
w = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
deficitSteps a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
w)
deficitTable :: Array Int Deficit
deficitTable :: Array Int Word
deficitTable = (Int, Int) -> [Word] -> Array Int Word
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
256) [Word]
deficitList
weightToDeficit :: Weight -> Deficit
weightToDeficit :: Int -> Word
weightToDeficit Int
w = Array Int Word
deficitTable Array Int Word -> Int -> Word
forall i e. Ix i => Array i e -> i -> e
! Int
w
empty :: PriorityQueue a
empty :: forall a. PriorityQueue a
empty = Word -> Heap a -> PriorityQueue a
forall a. Word -> Heap a -> PriorityQueue a
PriorityQueue Word
0 Heap a
forall p v. IntPSQ p v
P.empty
isEmpty :: PriorityQueue a -> Bool
isEmpty :: forall a. PriorityQueue a -> Bool
isEmpty PriorityQueue{Word
Heap a
baseDeficit :: forall a. PriorityQueue a -> Word
queue :: forall a. PriorityQueue a -> Heap a
baseDeficit :: Word
queue :: Heap a
..} = Heap a -> Bool
forall p v. IntPSQ p v -> Bool
P.null Heap a
queue
enqueue :: Key -> Precedence -> a -> PriorityQueue a -> PriorityQueue a
enqueue :: forall a.
Int -> Precedence -> a -> PriorityQueue a -> PriorityQueue a
enqueue Int
k p :: Precedence
p@Precedence{Int
Word
deficit :: Precedence -> Word
weight :: Precedence -> Int
dependency :: Precedence -> Int
deficit :: Word
weight :: Int
dependency :: Int
..} a
v PriorityQueue{Word
Heap a
baseDeficit :: forall a. PriorityQueue a -> Word
queue :: forall a. PriorityQueue a -> Heap a
baseDeficit :: Word
queue :: Heap a
..} =
Word -> Heap a -> PriorityQueue a
forall a. Word -> Heap a -> PriorityQueue a
PriorityQueue Word
baseDeficit Heap a
queue'
where
d :: Word
d = Int -> Word
weightToDeficit Int
weight
b :: Word
b = if Word
deficit Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Word
baseDeficit else Word
deficit
deficit' :: Word
deficit' = Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word
b Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
d) Word
baseDeficit
p' :: Precedence
p' = Precedence
p { deficit :: Word
deficit = Word
deficit' }
queue' :: Heap a
queue' = Int -> Precedence -> a -> Heap a -> Heap a
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
P.insert Int
k Precedence
p' a
v Heap a
queue
dequeue :: PriorityQueue a -> Maybe (Key, Precedence, a, PriorityQueue a)
dequeue :: forall a.
PriorityQueue a -> Maybe (Int, Precedence, a, PriorityQueue a)
dequeue PriorityQueue{Word
Heap a
baseDeficit :: forall a. PriorityQueue a -> Word
queue :: forall a. PriorityQueue a -> Heap a
baseDeficit :: Word
queue :: Heap a
..} = case Heap a -> Maybe (Int, Precedence, a, Heap a)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
P.minView Heap a
queue of
Maybe (Int, Precedence, a, Heap a)
Nothing -> Maybe (Int, Precedence, a, PriorityQueue a)
forall a. Maybe a
Nothing
Just (Int
k, Precedence
p, a
v, Heap a
queue') -> let base :: Word
base = Precedence -> Word
deficit Precedence
p
in (Int, Precedence, a, PriorityQueue a)
-> Maybe (Int, Precedence, a, PriorityQueue a)
forall a. a -> Maybe a
Just (Int
k, Precedence
p, a
v, Word -> Heap a -> PriorityQueue a
forall a. Word -> Heap a -> PriorityQueue a
PriorityQueue Word
base Heap a
queue')
delete :: Key -> PriorityQueue a -> (Maybe a, PriorityQueue a)
delete :: forall a. Int -> PriorityQueue a -> (Maybe a, PriorityQueue a)
delete Int
k q :: PriorityQueue a
q@PriorityQueue{Word
Heap a
baseDeficit :: forall a. PriorityQueue a -> Word
queue :: forall a. PriorityQueue a -> Heap a
baseDeficit :: Word
queue :: Heap a
..} = case (Maybe (Precedence, a) -> (Maybe a, Maybe (Precedence, a)))
-> Int -> Heap a -> (Maybe a, Heap a)
forall p v b.
Ord p =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> Int -> IntPSQ p v -> (b, IntPSQ p v)
P.alter Maybe (Precedence, a) -> (Maybe a, Maybe (Precedence, a))
forall {a} {a} {a}. Maybe (a, a) -> (Maybe a, Maybe a)
f Int
k Heap a
queue of
(mv :: Maybe a
mv@(Just a
_), Heap a
queue') -> case Heap a -> Maybe (Int, Precedence, a, Heap a)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
P.minView Heap a
queue of
Maybe (Int, Precedence, a, Heap a)
Nothing -> String -> (Maybe a, PriorityQueue a)
forall a. HasCallStack => String -> a
error String
"delete"
Just (Int
k',Precedence
p',a
_,Heap a
_)
| Int
k' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k -> (Maybe a
mv, Word -> Heap a -> PriorityQueue a
forall a. Word -> Heap a -> PriorityQueue a
PriorityQueue (Precedence -> Word
deficit Precedence
p') Heap a
queue')
| Bool
otherwise -> (Maybe a
mv, Word -> Heap a -> PriorityQueue a
forall a. Word -> Heap a -> PriorityQueue a
PriorityQueue Word
baseDeficit Heap a
queue')
(Maybe a
Nothing, Heap a
_) -> (Maybe a
forall a. Maybe a
Nothing, PriorityQueue a
q)
where
f :: Maybe (a, a) -> (Maybe a, Maybe a)
f Maybe (a, a)
Nothing = (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
f (Just (a
_,a
v)) = (a -> Maybe a
forall a. a -> Maybe a
Just a
v, Maybe a
forall a. Maybe a
Nothing)