{-# 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