module Network.HTTP2.RandomSkewHeap (
Heap
, empty
, isEmpty
, singleton
, insert
, uncons
) where
import Network.HTTP2.Types (Weight)
import System.IO.Unsafe (unsafePerformIO)
import System.Random.MWC (createSystemRandom, uniformR, GenIO)
data Heap a = Leaf | Node Weight
a Weight !(Heap a) !(Heap a) deriving Show
empty :: Heap a
empty = Leaf
isEmpty :: Heap a -> Bool
isEmpty Leaf = True
isEmpty _ = False
singleton :: a -> Weight -> Heap a
singleton a w = Node w a w Leaf Leaf
insert :: a -> Weight -> Heap a -> Heap a
insert a w t = merge (singleton a w) t
merge :: Heap t -> Heap t -> Heap t
merge t Leaf = t
merge Leaf t = t
merge l@(Node tw1 x1 w1 ll lr) r@(Node tw2 x2 w2 rl rr)
| g <= tw1 = Node tw x1 w1 lr $ merge ll r
| otherwise = Node tw x2 w2 rr $ merge rl l
where
tw = tw1 + tw2
g = unsafePerformIO $ uniformR (1,tw) gen
uncons :: Heap a -> Maybe (a, Weight, Heap a)
uncons Leaf = Nothing
uncons (Node _ a w l r) = Just (a, w, t)
where
!t = merge l r
gen :: GenIO
gen = unsafePerformIO createSystemRandom
main = do
let q = insert "c" 1 $ insert "b" 101 $ insert "a" 201 empty
loop 1000 q
where
loop 0 _ = return ()
loop n q = do
case uncons q of
Nothing -> error "Nothing"
Just (x, w, q') -> do
putStrLn x
loop (n1) (insert x w q')