{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.PQueue.Prio.Max (
MaxPQueue,
empty,
singleton,
insert,
insertBehind,
union,
unions,
null,
size,
findMax,
getMax,
deleteMax,
deleteFindMax,
adjustMax,
adjustMaxWithKey,
updateMax,
updateMaxWithKey,
maxView,
maxViewWithKey,
map,
mapWithKey,
mapKeys,
mapKeysMonotonic,
foldrWithKey,
foldlWithKey,
traverseWithKey,
take,
drop,
splitAt,
takeWhile,
takeWhileWithKey,
dropWhile,
dropWhileWithKey,
span,
spanWithKey,
break,
breakWithKey,
filter,
filterWithKey,
partition,
partitionWithKey,
mapMaybe,
mapMaybeWithKey,
mapEither,
mapEitherWithKey,
fromList,
fromAscList,
fromDescList,
keys,
elems,
assocs,
toAscList,
toDescList,
toList,
foldrU,
foldrWithKeyU,
foldlU,
foldlWithKeyU,
traverseU,
traverseWithKeyU,
keysU,
elemsU,
assocsU,
toListU,
seqSpine
)
where
import Control.Applicative (Applicative, (<$>))
import Data.Monoid (Monoid(mempty, mappend, mconcat))
import Data.Traversable (Traversable(traverse))
import Data.Foldable (Foldable, foldr, foldl)
import Data.Maybe (fromMaybe)
import Data.PQueue.Prio.Max.Internals
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif
import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null, foldr, foldl)
import qualified Data.PQueue.Prio.Min as Q
#ifdef __GLASGOW_HASKELL__
import Text.Read (Lexeme(Ident), lexP, parens, prec,
readPrec, readListPrec, readListPrecDefault)
#else
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif
first' :: (a -> b) -> (a, c) -> (b, c)
first' f (a, c) = (f a, c)
#if MIN_VERSION_base(4,9,0)
instance Ord k => Semigroup (MaxPQueue k a) where
(<>) = union
#endif
instance Ord k => Monoid (MaxPQueue k a) where
mempty = empty
mappend = union
mconcat = unions
instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where
showsPrec p xs = showParen (p > 10) $
showString "fromDescList " . shows (toDescList xs)
instance (Read k, Read a) => Read (MaxPQueue k a) where
#ifdef __GLASGOW_HASKELL__
readPrec = parens $ prec 10 $ do
Ident "fromDescList" <- lexP
xs <- readPrec
return (fromDescList xs)
readListPrec = readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \r -> do
("fromDescList",s) <- lex r
(xs,t) <- reads s
return (fromDescList xs,t)
#endif
instance Functor (MaxPQueue k) where
fmap f (MaxPQ q) = MaxPQ (fmap f q)
instance Ord k => Foldable (MaxPQueue k) where
foldr f z (MaxPQ q) = foldr f z q
foldl f z (MaxPQ q) = foldl f z q
instance Ord k => Traversable (MaxPQueue k) where
traverse f (MaxPQ q) = MaxPQ <$> traverse f q
empty :: MaxPQueue k a
empty = MaxPQ Q.empty
singleton :: k -> a -> MaxPQueue k a
singleton k a = MaxPQ (Q.singleton (Down k) a)
insert :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a
insert k a (MaxPQ q) = MaxPQ (Q.insert (Down k) a q)
insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a
insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q)
union :: Ord k => MaxPQueue k a -> MaxPQueue k a -> MaxPQueue k a
MaxPQ q1 `union` MaxPQ q2 = MaxPQ (q1 `Q.union` q2)
unions :: Ord k => [MaxPQueue k a] -> MaxPQueue k a
unions qs = MaxPQ (Q.unions [q | MaxPQ q <- qs])
null :: MaxPQueue k a -> Bool
null (MaxPQ q) = Q.null q
size :: MaxPQueue k a -> Int
size (MaxPQ q) = Q.size q
findMax :: MaxPQueue k a -> (k, a)
findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax
getMax :: MaxPQueue k a -> Maybe (k, a)
getMax (MaxPQ q) = do
(Down k, a) <- Q.getMin q
return (k, a)
deleteMax :: Ord k => MaxPQueue k a -> MaxPQueue k a
deleteMax (MaxPQ q) = MaxPQ (Q.deleteMin q)
deleteFindMax :: Ord k => MaxPQueue k a -> ((k, a), MaxPQueue k a)
deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey
adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a
adjustMax = adjustMaxWithKey . const
adjustMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a
adjustMaxWithKey f (MaxPQ q) = MaxPQ (Q.adjustMinWithKey (f . unDown) q)
updateMax :: Ord k => (a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a
updateMax = updateMaxWithKey . const
updateMaxWithKey :: Ord k => (k -> a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a
updateMaxWithKey f (MaxPQ q) = MaxPQ (Q.updateMinWithKey (f . unDown) q)
maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a)
maxView q = do
((_, a), q') <- maxViewWithKey q
return (a, q')
maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a)
maxViewWithKey (MaxPQ q) = do
((Down k, a), q') <- Q.minViewWithKey q
return ((k, a), MaxPQ q')
map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b
map = mapWithKey . const
mapWithKey :: (k -> a -> b) -> MaxPQueue k a -> MaxPQueue k b
mapWithKey f (MaxPQ q) = MaxPQ (Q.mapWithKey (f . unDown) q)
mapKeys :: Ord k' => (k -> k') -> MaxPQueue k a -> MaxPQueue k' a
mapKeys f (MaxPQ q) = MaxPQ (Q.mapKeys (fmap f) q)
mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a
mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q)
foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b
foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q
foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b
foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (\z -> f z . unDown) z0 q
traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q
take :: Ord k => Int -> MaxPQueue k a -> [(k, a)]
take k (MaxPQ q) = fmap (first' unDown) (Q.take k q)
drop :: Ord k => Int -> MaxPQueue k a -> MaxPQueue k a
drop k (MaxPQ q) = MaxPQ (Q.drop k q)
splitAt :: Ord k => Int -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
splitAt k (MaxPQ q) = case Q.splitAt k q of
(xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)]
takeWhile = takeWhileWithKey . const
takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> [(k, a)]
takeWhileWithKey p (MaxPQ q) = fmap (first' unDown) (Q.takeWhileWithKey (p . unDown) q)
dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
dropWhile = dropWhileWithKey . const
dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
dropWhileWithKey p (MaxPQ q) = MaxPQ (Q.dropWhileWithKey (p . unDown) q)
span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
span = spanWithKey . const
break :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
break = breakWithKey . const
spanWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
spanWithKey p (MaxPQ q) = case Q.spanWithKey (p . unDown) q of
(xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
breakWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
breakWithKey p (MaxPQ q) = case Q.breakWithKey (p . unDown) q of
(xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
filter = filterWithKey . const
filterWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
filterWithKey p (MaxPQ q) = MaxPQ (Q.filterWithKey (p . unDown) q)
partition :: Ord k => (a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)
partition = partitionWithKey . const
partitionWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)
partitionWithKey p (MaxPQ q) = case Q.partitionWithKey (p . unDown) q of
(q1, q0) -> (MaxPQ q1, MaxPQ q0)
mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b
mapMaybe = mapMaybeWithKey . const
mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b
mapMaybeWithKey f (MaxPQ q) = MaxPQ (Q.mapMaybeWithKey (f . unDown) q)
mapEither :: Ord k => (a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)
mapEither = mapEitherWithKey . const
mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)
mapEitherWithKey f (MaxPQ q) = case Q.mapEitherWithKey (f . unDown) q of
(qL, qR) -> (MaxPQ qL, MaxPQ qR)
fromList :: Ord k => [(k, a)] -> MaxPQueue k a
fromList = MaxPQ . Q.fromList . fmap (first' Down)
fromAscList :: [(k, a)] -> MaxPQueue k a
fromAscList = MaxPQ . Q.fromDescList . fmap (first' Down)
fromDescList :: [(k, a)] -> MaxPQueue k a
fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down)
keys :: Ord k => MaxPQueue k a -> [k]
keys = fmap fst . toDescList
elems :: Ord k => MaxPQueue k a -> [a]
elems = fmap snd . toDescList
assocs :: Ord k => MaxPQueue k a -> [(k, a)]
assocs = toDescList
toAscList :: Ord k => MaxPQueue k a -> [(k, a)]
toAscList (MaxPQ q) = fmap (first' unDown) (Q.toDescList q)
toDescList :: Ord k => MaxPQueue k a -> [(k, a)]
toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q)
toList :: Ord k => MaxPQueue k a -> [(k, a)]
toList = toDescList
foldrU :: (a -> b -> b) -> b -> MaxPQueue k a -> b
foldrU = foldrWithKeyU . const
foldrWithKeyU :: (k -> a -> b -> b) -> b -> MaxPQueue k a -> b
foldrWithKeyU f z (MaxPQ q) = Q.foldrWithKeyU (f . unDown) z q
foldlU :: (b -> a -> b) -> b -> MaxPQueue k a -> b
foldlU f = foldlWithKeyU (const . f)
foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b
foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\z -> f z . unDown) z0 q
traverseU :: (Applicative f) => (a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
traverseU = traverseWithKeyU . const
traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q
keysU :: MaxPQueue k a -> [k]
keysU = fmap fst . toListU
elemsU :: MaxPQueue k a -> [a]
elemsU = fmap snd . toListU
assocsU :: MaxPQueue k a -> [(k, a)]
assocsU = toListU
toListU :: MaxPQueue k a -> [(k, a)]
toListU (MaxPQ q) = fmap (first' unDown) (Q.toListU q)
seqSpine :: MaxPQueue k a -> b -> b
seqSpine (MaxPQ q) = Q.seqSpine q