{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.PQueue.Prio.Min (
MinPQueue,
empty,
singleton,
insert,
insertBehind,
union,
unions,
null,
size,
findMin,
getMin,
deleteMin,
deleteFindMin,
adjustMin,
adjustMinWithKey,
updateMin,
updateMinWithKey,
minView,
minViewWithKey,
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, pure, (<*>), (<$>))
import qualified Data.List as List
import qualified Data.Foldable as Fold(Foldable(..))
import Data.Monoid (Monoid(mempty, mappend, mconcat))
import Data.Traversable (Traversable(traverse))
import Data.Foldable (Foldable)
import Data.Maybe (fromMaybe)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif
import Data.PQueue.Prio.Internals
import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null)
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Text.Read (Lexeme(Ident), lexP, parens, prec,
readPrec, readListPrec, readListPrecDefault)
#else
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(f .: g) x y = f (g x y)
uncurry' :: (a -> b -> c) -> (a, b) -> c
uncurry' f (a, b) = f a b
infixr 8 .:
#if MIN_VERSION_base(4,9,0)
instance Ord k => Semigroup (MinPQueue k a) where
(<>) = union
#endif
instance Ord k => Monoid (MinPQueue k a) where
mempty = empty
mappend = union
mconcat = unions
instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where
showsPrec p xs = showParen (p > 10) $
showString "fromAscList " . shows (toAscList xs)
instance (Read k, Read a) => Read (MinPQueue k a) where
#ifdef __GLASGOW_HASKELL__
readPrec = parens $ prec 10 $ do
Ident "fromAscList" <- lexP
xs <- readPrec
return (fromAscList xs)
readListPrec = readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \r -> do
("fromAscList",s) <- lex r
(xs,t) <- reads s
return (fromAscList xs,t)
#endif
unions :: Ord k => [MinPQueue k a] -> MinPQueue k a
unions = List.foldl union empty
findMin :: MinPQueue k a -> (k, a)
findMin = fromMaybe (error "Error: findMin called on an empty queue") . getMin
deleteMin :: Ord k => MinPQueue k a -> MinPQueue k a
deleteMin = updateMin (const Nothing)
deleteFindMin :: Ord k => MinPQueue k a -> ((k, a), MinPQueue k a)
deleteFindMin = fromMaybe (error "Error: deleteFindMin called on an empty queue") . minViewWithKey
adjustMin :: (a -> a) -> MinPQueue k a -> MinPQueue k a
adjustMin = adjustMinWithKey . const
updateMin :: Ord k => (a -> Maybe a) -> MinPQueue k a -> MinPQueue k a
updateMin = updateMinWithKey . const
minView :: Ord k => MinPQueue k a -> Maybe (a, MinPQueue k a)
minView q = do ((_, a), q') <- minViewWithKey q
return (a, q')
map :: (a -> b) -> MinPQueue k a -> MinPQueue k b
map = mapWithKey . const
mapKeys :: Ord k' => (k -> k') -> MinPQueue k a -> MinPQueue k' a
mapKeys f q = fromList [(f k, a) | (k, a) <- toListU q]
traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseWithKey f q = case minViewWithKey q of
Nothing -> pure empty
Just ((k, a), q') -> insertMin k <$> f k a <*> traverseWithKey f q'
mapMaybe :: Ord k => (a -> Maybe b) -> MinPQueue k a -> MinPQueue k b
mapMaybe = mapMaybeWithKey . const
mapEither :: Ord k => (a -> Either b c) -> MinPQueue k a -> (MinPQueue k b, MinPQueue k c)
mapEither = mapEitherWithKey . const
filter :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a
filter = filterWithKey . const
filterWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a
filterWithKey p = mapMaybeWithKey (\k a -> if p k a then Just a else Nothing)
partition :: Ord k => (a -> Bool) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a)
partition = partitionWithKey . const
partitionWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> (MinPQueue k a, MinPQueue k a)
partitionWithKey p = mapEitherWithKey (\k a -> if p k a then Left a else Right a)
{-# INLINE take #-}
take :: Ord k => Int -> MinPQueue k a -> [(k, a)]
take n = List.take n . toAscList
drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a
drop n0 q0
| n0 <= 0 = q0
| n0 >= size q0 = empty
| otherwise = drop' n0 q0
where
drop' n q
| n == 0 = q
| otherwise = drop' (n - 1) (deleteMin q)
splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
splitAt n q
| n <= 0 = ([], q)
| otherwise = n `seq` case minViewWithKey q of
Just (ka, q') -> let (kas, q'') = splitAt (n - 1) q' in (ka : kas, q'')
_ -> ([], q)
{-# INLINE takeWhile #-}
takeWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> [(k, a)]
takeWhile = takeWhileWithKey . const
{-# INLINE takeWhileWithKey #-}
takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> [(k, a)]
takeWhileWithKey p0 = takeWhileFB (uncurry' p0) . toAscList where
takeWhileFB p xs = build (\c n -> foldr (\x z -> if p x then x `c` z else n) n xs)
dropWhile :: Ord k => (a -> Bool) -> MinPQueue k a -> MinPQueue k a
dropWhile = dropWhileWithKey . const
dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> MinPQueue k a
dropWhileWithKey p q = case minViewWithKey q of
Just ((k, a), q')
| p k a -> dropWhileWithKey p q'
_ -> q
span :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
span = spanWithKey . const
break :: Ord k => (a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
break p = span (not . p)
spanWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
spanWithKey p q = case minViewWithKey q of
Just (t@(k, a), q')
| p k a -> let (kas, q'') = spanWithKey p q' in (t : kas, q'')
_ -> ([], q)
breakWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
breakWithKey p = spanWithKey (not .: p)
fromList :: Ord k => [(k, a)] -> MinPQueue k a
fromList = foldr (uncurry' insert) empty
fromAscList :: [(k, a)] -> MinPQueue k a
fromAscList = foldr (uncurry' insertMin) empty
fromDescList :: [(k, a)] -> MinPQueue k a
fromDescList = List.foldl' (\q (k, a) -> insertMin k a q) empty
{-# RULES
"fromList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .
fromList (build g) = g (uncurry' insert) empty;
"fromAscList/build" forall (g :: forall b . ((k, a) -> b -> b) -> b -> b) .
fromAscList (build g) = g (uncurry' insertMin) empty;
#-}
{-# INLINE keys #-}
keys :: Ord k => MinPQueue k a -> [k]
keys = List.map fst . toAscList
{-# INLINE elems #-}
elems :: Ord k => MinPQueue k a -> [a]
elems = List.map snd . toAscList
toAscList :: Ord k => MinPQueue k a -> [(k, a)]
toAscList = foldrWithKey (curry (:)) []
toDescList :: Ord k => MinPQueue k a -> [(k, a)]
toDescList = foldlWithKey (\z k a -> (k, a) : z) []
{-# RULES
"toAscList" toAscList = \q -> build (\c n -> foldrWithKey (curry c) n q);
"toDescList" toDescList = \q -> build (\c n -> foldlWithKey (\z k a -> (k, a) `c` z) n q);
"toListU" toListU = \q -> build (\c n -> foldrWithKeyU (curry c) n q);
#-}
{-# INLINE toList #-}
toList :: Ord k => MinPQueue k a -> [(k, a)]
toList = toAscList
{-# INLINE assocs #-}
assocs :: Ord k => MinPQueue k a -> [(k, a)]
assocs = toAscList
{-# INLINE keysU #-}
keysU :: MinPQueue k a -> [k]
keysU = List.map fst . toListU
{-# INLINE elemsU #-}
elemsU :: MinPQueue k a -> [a]
elemsU = List.map snd . toListU
{-# INLINE assocsU #-}
assocsU :: MinPQueue k a -> [(k, a)]
assocsU = toListU
toListU :: MinPQueue k a -> [(k, a)]
toListU = foldrWithKeyU (curry (:)) []
foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b
foldrU = foldrWithKeyU . const
foldlU :: (b -> a -> b) -> b -> MinPQueue k a -> b
foldlU f = foldlWithKeyU (const . f)
traverseU :: (Applicative f) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
traverseU = traverseWithKeyU . const
instance Functor (MinPQueue k) where
fmap = map
instance Ord k => Foldable (MinPQueue k) where
foldr = foldrWithKey . const
foldl f = foldlWithKey (const . f)
instance Ord k => Traversable (MinPQueue k) where
traverse = traverseWithKey . const