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.Semigroup
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 _ (Pt t))) = maybe "" (T.drawTree . fmap show . T.unfoldTree (\ (T x ts) -> (x, ts))) t
instance Ord e => Semigroup (Tree e) where
t1@(T x1 ts1) `sappend` 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 = PQ mempty
singleton = PQ . single
fromList xs = PQ (HQ (length xs) (Pt $ sconcat [T x [] | x <- xs]))
xs `insertAll` q = q `mappend` fromList xs
merge = mappend
mergeAll = mconcat
extract (PQ (HQ n (Pt t))) = fmap (fmap (PQ . HQ (n1) . Pt) . extract') t
where extract' (T x ts) = (x, fusing ts)
toList_ (PQ (HQ _ (Pt t))) = maybe [] flatten t
where flatten (T x ts) = x:concatMap flatten ts
null (PQ (HQ _ (Pt Nothing))) = True
null _ = False
size (PQ (HQ n _)) = n
single :: e -> HeapQ (Tree e)
single x = HQ 1 $ pJust (T x [])