{-# LANGUAGE CPP #-}

module Data.PQueue.Max (
	MaxQueue,
	-- * Construction
	empty,
	singleton,
	insert,
	union,
	unions,
	-- * Query
	null,
	size,
	-- ** Maximum view
	findMax,
	getMax,
	deleteMax,
	deleteFindMax,
	maxView,
	-- * Traversal
	-- ** Map
	map,
	mapMonotonic,
	-- ** Fold
	foldr,
	foldl,
	-- ** Traverse
	traverse,
	-- * Subsets
	-- ** Indexed
	take,
	drop,
	splitAt,
	-- ** Predicates
	takeWhile,
	dropWhile,
	span,
	break,
	-- *** Filter
	filter,
	partition,
	-- * List operations
	-- ** Conversion from lists
	fromList,
	fromDescList,
	fromAscList,
	-- ** Conversion to lists
	elems,
	toList,
	toDescList,
	-- * Conversion with MaxPQueue
	pqueueKeys,
	-- * Unordered operations
	foldrU,
	foldlU,
	toListU,
	-- * Helper methods
	seqSpine) where

import Control.Applicative hiding (empty)
import Data.Maybe hiding (mapMaybe)
import Data.Monoid
import qualified Data.List as List
import qualified Data.PQueue.Prio.Max as Q

import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl)

#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Text.Read (Lexeme(Ident), lexP, parens, prec,
	readPrec, readListPrec, readListPrecDefault)
import Data.Data
#else
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif

newtype MaxQueue a = MaxQ (Q.MaxPQueue a ()) deriving (Eq, Ord)

null :: MaxQueue a -> Bool
null (MaxQ q) = Q.null q

size :: MaxQueue a -> Int
size (MaxQ q) = Q.size q

empty :: MaxQueue a
empty = MaxQ Q.empty

singleton :: a -> MaxQueue a
singleton a = MaxQ (Q.singleton a ())

insert :: Ord a => a -> MaxQueue a -> MaxQueue a
insert a (MaxQ q) = MaxQ (Q.insert a () q)

union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a
MaxQ q1 `union` MaxQ q2 = MaxQ (q1 `Q.union` q2)

unions :: Ord a => [MaxQueue a] -> MaxQueue a
unions qs = MaxQ (Q.unions [q | MaxQ q <- qs])

findMax :: MaxQueue a -> a
findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax

getMax :: MaxQueue a -> Maybe a
getMax (MaxQ q) = fst <$> Q.getMax q

deleteMax :: Ord a => MaxQueue a -> MaxQueue a
deleteMax (MaxQ q) = MaxQ (Q.deleteMax q)

deleteFindMax :: Ord a => MaxQueue a -> (a, MaxQueue a)
deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxView

maxView :: Ord a => MaxQueue a -> Maybe (a, MaxQueue a)
maxView (MaxQ q) = do
	((a, _), q') <- Q.maxViewWithKey q
	return (a, MaxQ q')

map :: Ord b => (a -> b) -> MaxQueue a -> MaxQueue b
map f (MaxQ q) = MaxQ (Q.mapKeys f q)

mapMonotonic :: (a -> b) -> MaxQueue a -> MaxQueue b
mapMonotonic f (MaxQ q) = MaxQ (Q.mapKeysMonotonic f q)

traverse :: (Applicative f, Ord a, Ord b) => (a -> f b) -> MaxQueue a -> f (MaxQueue b)
traverse f q = case maxView q of
	Nothing		-> pure empty
	Just (a, q')	-> insert <$> f a <*> traverse f q'

foldr :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b
foldr f z (MaxQ q) = Q.foldrWithKey (const . f) z q

foldl :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b
foldl f z (MaxQ q) = Q.foldlWithKey (\ z -> const . f z) z q

foldrU :: (a -> b -> b) -> b -> MaxQueue a -> b
foldrU f z (MaxQ q) = Q.foldrWithKeyU (const . f) z q

foldlU :: (b -> a -> b) -> b -> MaxQueue a -> b
foldlU f z (MaxQ q) = Q.foldlWithKeyU (\ z -> const . f z) z q

-- {-# INLINE take #-}
take :: Ord a => Int -> MaxQueue a -> [a]
take k (MaxQ q) = List.map fst (Q.take k q)

drop :: Ord a => Int -> MaxQueue a -> MaxQueue a
drop k (MaxQ q) = MaxQ (Q.drop k q)

splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)
splitAt k (MaxQ q) = case Q.splitAt k q of
	(xs, q') -> (List.map fst xs, MaxQ q')

takeWhile :: Ord a => (a -> Bool) -> MaxQueue a -> [a]
takeWhile p (MaxQ q) = List.map fst (Q.takeWhileWithKey (const . p) q)

dropWhile :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a
dropWhile p (MaxQ q) = MaxQ (Q.dropWhileWithKey (const . p) q)

span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)
span p (MaxQ q) = case Q.spanWithKey (const . p) q of
	(xs, q') -> (List.map fst xs, MaxQ q')

break :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)
break p (MaxQ q) = case Q.breakWithKey (const . p) q of
	(xs, q') -> (List.map fst xs, MaxQ q')

filter :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a
filter f (MaxQ q) = MaxQ (Q.filterWithKey (const . f) q)

partition :: Ord a => (a -> Bool) -> MaxQueue a -> (MaxQueue a, MaxQueue a)
partition p (MaxQ q) = case Q.partitionWithKey (const . p) q of
	(q0, q1) -> (MaxQ q0, MaxQ q1)

{-# INLINE elems #-}
elems :: Ord a => MaxQueue a -> [a]
elems = toList

{-# INLINE toList #-}
toList :: Ord a => MaxQueue a -> [a]
toList (MaxQ q) = Q.keys q

{-# INLINE toDescList #-}
toDescList :: Ord a => MaxQueue a -> [a]
toDescList = toList

{-# INLINE toAscList #-}
toAscList :: Ord a => MaxQueue a -> [a]
toAscList (MaxQ q) = List.map fst (Q.toAscList q)

{-# INLINE elemsU #-}
elemsU :: Ord a => MaxQueue a -> [a]
elemsU = toListU

{-# INLINE toListU #-}
toListU :: Ord a => MaxQueue a -> [a]
toListU (MaxQ q) = Q.keysU q

{-# INLINE fromList #-}
fromList :: Ord a => [a] -> MaxQueue a
fromList as = MaxQ (Q.fromList [(a, ()) | a <- as])

{-# INLINE fromDescList #-}
fromDescList :: [a] -> MaxQueue a
fromDescList as = MaxQ (Q.fromDescList [(a, ()) | a <- as])

{-# INLINE fromAscList #-}
fromAscList :: [a] -> MaxQueue a
fromAscList as = MaxQ (Q.fromAscList [(a, ()) | a <- as])

pqueueKeys :: Q.MaxPQueue k a -> MaxQueue k
#ifdef __GLASGOW_HASKELL__
pqueueKeys q = MaxQ (() <$ q)
#else
pqueueKeys q = MaxQ (fmap (const ()) q)
#endif

seqSpine :: MaxQueue a -> b -> b
seqSpine (MaxQ q) = Q.seqSpine q