module Data.Queue.SkewQueue (SkewQueue) where
import Data.Queue.Class
import Data.Queue.QueueHelpers
import GHC.Exts
import Data.Monoid
import Data.Ord
data BTree e = Tr {treeMin :: e, _left, _right :: Maybe (BTree e)}
newtype SkewQueue e = SQ (HeapQ (BTree e)) deriving (Monoid)
instance Ord e => Monoid (BTree e) where
mappend = let t1 `meld` t2 = case order (comparing treeMin) t1 t2 of
(Tr x l r, t') -> Tr x (endoMaybe meld r (Just t')) l
in meld
instance Ord e => Queuelike (SkewQueue e) where
type QueueKey (SkewQueue e) = e
empty = mempty
singleton = SQ . single
fromList xs = SQ $ fuseMerge (map single xs)
merge = mappend
mergeAll = mconcat
extract (SQ (HQ n t)) = fmap (\ (Tr x l r) -> (x, SQ (HQ n (l `mappend` r)))) t
size (SQ HQ{elts}) = elts
toList_ (SQ HQ{heap}) = flatten heap
single :: e -> HeapQ (BTree e)
single x = HQ 1 $ Just (Tr x Nothing Nothing)
flatten :: Maybe (BTree e) -> [e]
flatten h = build (flattenFB h) where
flattenFB h c n = maybe n (\ (Tr x l r) -> x `c` flattenFB l c (flattenFB r c n)) h