Skew.hs

module Network.QUIC.Stream.Skew (
    Skew(..)
  , empty
  , insert
  , deleteMin
  , deleteMinIf
--  , deleteMin'
--  , showSkew
  ) where

import Data.Maybe
import Data.Sequence (Seq, (><))
import qualified Data.Sequence as Seq
import Prelude hiding (minimum)

import Network.QUIC.Stream.Frag

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

data Skew a = Leaf | Node (Skew a) (Seq a) (Skew a) deriving Show

empty :: Skew a
empty = Leaf

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

-- | Insertion. Worst-case: O(N), amortized: O(log N).
insert :: Frag a => a -> Skew a -> Skew a
insert x t = merge (Node Leaf (Seq.singleton x) Leaf) t

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

-- | Finding the minimum element. Worst-case: O(1).
minimum :: Skew a -> Maybe (Seq a)
minimum Leaf         = Nothing
minimum (Node _ f _) = Just f

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

-- | Deleting the minimum element. Worst-case: O(N), amortized: O(log N).
deleteMin' :: Frag a => Skew a -> Skew a
deleteMin' Leaf         = Leaf
deleteMin' (Node l _ r) = merge l r

deleteMin :: Frag a => Skew a -> (Skew a, Maybe (Seq a))
deleteMin h = (deleteMin' h, minimum h)

deleteMinIf :: Frag a => Int -> Skew a -> (Skew a, Maybe (Seq a))
deleteMinIf off h = case minimum h of
  jf@(Just f)
    | currOff f == off                   -> (deleteMin' h, jf)
    | currOff f < off && off < nextOff f -> (deleteMin' h, shrink off <$> jf)
    | nextOff f <= off                   -> (deleteMin' h, Nothing)
  _                                      -> (h, Nothing)

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

-- | Merging two heaps. Worst-case: O(N), amortized: O(log N).
merge :: Frag a => Skew a -> Skew a -> Skew a
merge t1 Leaf = t1
merge Leaf t2 = t2
merge t1@(Node l1 f1 r1) t2@(Node l2 f2 r2)
  | e1 < s2   = Node r1 f1 (merge l1 t2)
  | e2 < s1   = Node r2 f2 (merge l2 t1)
  | otherwise = let f12 | e1 == s2             = f1 >< f2
                        | s1 == e2             = f2 >< f1
                        | s1 <= s2 && e2 <= e1 = f1
                        | s2 <= s1 && e1 <= e2 = f2
                        | s1 <= s2             = f1 >< shrink e1 f2
                        | otherwise            = f2 >< shrink e2 f1
                in Node (merge l1 l2) f12 (merge r1 r2)
  where
    s1 = currOff f1
    e1 = nextOff f1
    s2 = currOff f2
    e2 = nextOff f2

{-
showSkew :: Show a => Skew a -> String
showSkew = showSkew' ""

showSkew' :: Show a => String -> Skew a -> String
showSkew' _    Leaf = "\n"
showSkew' pref (Node l x r) = show x ++ "\n"
                           ++ pref ++ "+ " ++ showSkew' pref' l
                           ++ pref ++ "+ " ++ showSkew' pref' r
  where
    pref' = "  " ++ pref
-}