{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.PQueue.Min (
MinQueue,
empty,
null,
size,
findMin,
getMin,
deleteMin,
deleteFindMin,
minView,
singleton,
insert,
union,
unions,
(!!),
take,
drop,
splitAt,
takeWhile,
dropWhile,
span,
break,
filter,
partition,
mapMaybe,
mapEither,
map,
foldrAsc,
foldlAsc,
foldrDesc,
foldlDesc,
toList,
toAscList,
toDescList,
fromList,
fromAscList,
fromDescList,
mapU,
foldrU,
foldlU,
elemsU,
toListU,
keysQueue,
seqSpine) where
import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter, map)
import Data.Monoid (Monoid(mempty, mappend, mconcat))
import Data.Foldable (foldl, foldr, foldl')
import Data.Maybe (fromMaybe)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif
import qualified Data.List as List
import Data.PQueue.Internals
#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
instance (Ord a, Show a) => Show (MinQueue a) where
showsPrec p xs = showParen (p > 10) $
showString "fromAscList " . shows (toAscList xs)
instance Read a => Read (MinQueue 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
#if MIN_VERSION_base(4,9,0)
instance Ord a => Semigroup (MinQueue a) where
(<>) = union
#endif
instance Ord a => Monoid (MinQueue a) where
mempty = empty
mappend = union
mconcat = unions
findMin :: MinQueue a -> a
findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin
deleteMin :: Ord a => MinQueue a -> MinQueue a
deleteMin q = case minView q of
Nothing -> empty
Just (_, q') -> q'
deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)
deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView
unions :: Ord a => [MinQueue a] -> MinQueue a
unions = foldl union empty
(!!) :: Ord a => MinQueue a -> Int -> a
q !! n | n >= size q
= error "Data.PQueue.Min.!!: index too large"
q !! n = (List.!!) (toAscList q) n
{-# INLINE takeWhile #-}
takeWhile :: Ord a => (a -> Bool) -> MinQueue a -> [a]
takeWhile p = foldWhileFB p . toAscList
{-# INLINE foldWhileFB #-}
foldWhileFB :: (a -> Bool) -> [a] -> [a]
foldWhileFB p xs0 = build (\c nil -> let
consWhile x xs
| p x = x `c` xs
| otherwise = nil
in foldr consWhile nil xs0)
dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a
dropWhile p = drop' where
drop' q = case minView q of
Just (x, q') | p x -> drop' q'
_ -> q
span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
span p queue = case minView queue of
Just (x, q')
| p x -> let (ys, q'') = span p q' in (x : ys, q'')
_ -> ([], queue)
break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
break p = span (not . p)
{-# INLINE take #-}
take :: Ord a => Int -> MinQueue a -> [a]
take n = List.take n . toAscList
drop :: Ord a => Int -> MinQueue a -> MinQueue a
drop n queue = n `seq` case minView queue of
Just (_, queue')
| n > 0 -> drop (n - 1) queue'
_ -> queue
splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)
splitAt n queue = n `seq` case minView queue of
Just (x, queue')
| n > 0 -> let (xs, queue'') = splitAt (n - 1) queue' in (x : xs, queue'')
_ -> ([], queue)
filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a
filter p = mapMaybe (\x -> if p x then Just x else Nothing)
partition :: Ord a => (a -> Bool) -> MinQueue a -> (MinQueue a, MinQueue a)
partition p = mapEither (\x -> if p x then Left x else Right x)
map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b
map f = foldrU (insert . f) empty
{-# INLINE toAscList #-}
toAscList :: Ord a => MinQueue a -> [a]
toAscList queue = build (\c nil -> foldrAsc c nil queue)
{-# INLINE toDescList #-}
toDescList :: Ord a => MinQueue a -> [a]
toDescList queue = build (\c nil -> foldrDesc c nil queue)
{-# INLINE toList #-}
toList :: Ord a => MinQueue a -> [a]
toList = toAscList
{-# RULES
"toAscList" forall q . toAscList q = build (\c nil -> foldrAsc c nil q);
-- inlining doesn't seem to be working out =/
"toDescList" forall q . toDescList q = build (\c nil -> foldrDesc c nil q);
#-}
foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc = foldlAsc . flip
foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlDesc = foldrAsc . flip
{-# INLINE fromList #-}
fromList :: Ord a => [a] -> MinQueue a
fromList = foldr insert empty
{-# RULES
"fromList" fromList = foldr insert empty;
"fromAscList" fromAscList = foldr insertMinQ empty;
#-}
{-# INLINE fromAscList #-}
fromAscList :: [a] -> MinQueue a
fromAscList = foldr insertMinQ empty
fromDescList :: [a] -> MinQueue a
fromDescList = foldl' (flip insertMinQ) empty
mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU = mapMonotonic
{-# INLINE elemsU #-}
elemsU :: MinQueue a -> [a]
elemsU = toListU
toListU :: MinQueue a -> [a]
toListU q = build (\c n -> foldrU c n q)
{-# RULES
"foldr/toListU" forall f z q . foldr f z (toListU q) = foldrU f z q;
"foldl/toListU" forall f z q . foldl f z (toListU q) = foldlU f z q;
#-}