module Data.Queue.PQueue (PQueue, drawQueue) where
import Data.Queue.Class
import Data.Queue.QueueHelpers
import qualified Data.Tree as T
import Data.Maybe
import Data.Monoid
import Control.Monad
data Tree e = T e [Tree e]
newtype PQueue e = PQ (HeapQ (Tree e)) deriving (Monoid)
instance Show e => Show (PQueue e) where
show = drawQueue
drawQueue :: Show e => PQueue e -> String
drawQueue (PQ (HQ _ t)) = maybe "" (T.drawTree . fmap show . T.unfoldTree (\ (T x ts) -> (x, ts))) t
instance Ord e => Monoid (Tree e) where
t1@(T x1 ts1) `mappend` t2@(T x2 ts2)
| x1 <= x2 = T x1 (t2:ts1)
| otherwise = T x2 (t1:ts2)
instance Ord e => IQueue (PQueue e) where
type QueueKey (PQueue e) = e
empty = mempty
singleton = PQ . single
fromList xs = PQ $ fuseMergeM [single x | x <- xs]
xs `insertAll` q = q `mappend` fromList xs
merge = mappend
mergeAll qs = PQ (fuseMergeM [h | PQ h <- qs])
extract (PQ (HQ n t)) = fmap (fmap (PQ . HQ (n1)) . extract') t
where extract' (T x ts) = (x, fusing ts)
toList_ (PQ (HQ _ t)) = maybe [] flatten t
where flatten (T x ts) = x:concatMap flatten ts
null (PQ (HQ _ Nothing)) = True
null _ = False
size (PQ (HQ n _)) = n
single :: e -> HeapQ (Tree e)
single x = HQ 1 $ Just (T x [])