{-# LANGUAGE NamedFieldPuns, TypeSynonymInstances, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}
{-# OPTIONS -fno-warn-missing-methods -fno-warn-name-shadowing #-}
{- | An efficient implementation of a priority queue.

The implementation of 'PQueue' is based on a /pairing heap/, a simple and efficient implementation of a general-purpose priority queue.  'PQueue' supports 'insert', 'merge', and 'peek' in constant time, and 'extract' and 'delete' in logarithmic time.
-}

module Data.Queue.PQueue (PQueue) where

import Data.Queue.Class
import Data.Queue.QueueHelpers

import Data.Maybe
import Data.Monoid

import Control.Monad

-- Like with SkewQueue, the real meat of the pairing heap is very succinctly presented: it's all in the Monoid instance, and in the extract method, where the fusing method from QueueHelpers (already used for QueueHelpers' generic merging implementation) provides all the magic.  Everything else is deliciously succinct boilerplate, largely derived from HeapQ's Monoid instance.

data Tree e = T e [Tree e]
newtype PQueue e = PQ (HeapQ (Tree e)) deriving (Monoid, Queuelike)

instance Ord e => Monoid (Tree e) where
	-- no actual mzero instance, but induces a correct Monoid instance for Heap e
	t1@(T x1 ts1) `mappend` t2@(T x2 ts2) 
		| x1 <= x2	= T x1 (t2:ts1)
		| otherwise	= T x2 (t1:ts2)

instance Ord e => Queuelike (HeapQ (Tree e)) where
	{-# INLINE fromList #-}
	{-# INLINE toList_ #-}
	{-# INLINE mergeAll #-}
	{-# INLINE insertAll #-}

	type QueueKey (HeapQ (Tree e)) = e

	empty = mempty
	singleton = single
	fromList ts = mconcat (map single ts)

	x `insert` q = q `mappend` single x
	xs `insertAll` q = q `mappend` fromList xs
	merge = mappend
	mergeAll = mconcat
	
	extract (HQ n t) = fmap (\ (T x ts) ->  (x, HQ (n-1) (fusing ts))) t
	toList_ = maybe [] flatten . heap
	size = elts

single :: e -> HeapQ (Tree e)
single x = HQ 1 $ Just (T x [])

flatten :: Tree e -> [e]
flatten (T x ts) = [x] ++ concatMap flatten ts