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, Queuelike)
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 (HeapQ (BTree e)) where
type QueueKey (HeapQ (BTree e)) = e
empty = mempty
singleton = single
fromList xs = mconcat (map single xs)
merge = mappend
mergeAll = mconcat
extract (HQ n t) = fmap (\ (Tr x l r) -> (x, HQ n (l `mappend` r))) t
size = elts
toList_ = 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