{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
module Data.HashPSQ.Internal
    ( -- * Type
      Bucket (..)
    , mkBucket
    , HashPSQ (..)

      -- * Query
    , null
    , size
    , member
    , lookup
    , findMin

      -- * Construction
    , empty
    , singleton

      -- * Insertion
    , insert

      -- * Delete/update
    , delete
    , deleteMin
    , alter
    , alterMin

      -- * Lists
    , fromList
    , toList
    , keys

      -- * Views
    , insertView
    , deleteView
    , minView
    , atMostView

      -- * Traversal
    , map
    , unsafeMapMonotonic
    , fold'

      -- * Unsafe operations
    , unsafeLookupIncreasePriority
    , unsafeInsertIncreasePriority
    , unsafeInsertIncreasePriorityView

      -- * Validity check
    , valid
    ) where

import           Control.DeepSeq      (NFData (..))
import           Data.Foldable        (Foldable)
import           Data.Hashable
import qualified Data.List            as List
import           Data.Maybe           (isJust)
import           Data.Traversable
import           Prelude              hiding (foldr, lookup, map, null)

import qualified Data.IntPSQ.Internal as IntPSQ
import qualified Data.OrdPSQ          as OrdPSQ

------------------------------------------------------------------------------
-- Types
------------------------------------------------------------------------------

data Bucket k p v = B !k !v !(OrdPSQ.OrdPSQ k p v)
    deriving (forall a. Bucket k p a -> Bool
forall m a. Monoid m => (a -> m) -> Bucket k p a -> m
forall a b. (a -> b -> b) -> b -> Bucket k p a -> b
forall k p a. Eq a => a -> Bucket k p a -> Bool
forall k p a. Num a => Bucket k p a -> a
forall k p a. Ord a => Bucket k p a -> a
forall k p m. Monoid m => Bucket k p m -> m
forall k p a. Bucket k p a -> Bool
forall k p a. Bucket k p a -> Int
forall k p a. Bucket k p a -> [a]
forall k p a. (a -> a -> a) -> Bucket k p a -> a
forall k p m a. Monoid m => (a -> m) -> Bucket k p a -> m
forall k p b a. (b -> a -> b) -> b -> Bucket k p a -> b
forall k p a b. (a -> b -> b) -> b -> Bucket k p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Bucket k p a -> a
$cproduct :: forall k p a. Num a => Bucket k p a -> a
sum :: forall a. Num a => Bucket k p a -> a
$csum :: forall k p a. Num a => Bucket k p a -> a
minimum :: forall a. Ord a => Bucket k p a -> a
$cminimum :: forall k p a. Ord a => Bucket k p a -> a
maximum :: forall a. Ord a => Bucket k p a -> a
$cmaximum :: forall k p a. Ord a => Bucket k p a -> a
elem :: forall a. Eq a => a -> Bucket k p a -> Bool
$celem :: forall k p a. Eq a => a -> Bucket k p a -> Bool
length :: forall a. Bucket k p a -> Int
$clength :: forall k p a. Bucket k p a -> Int
null :: forall a. Bucket k p a -> Bool
$cnull :: forall k p a. Bucket k p a -> Bool
toList :: forall a. Bucket k p a -> [a]
$ctoList :: forall k p a. Bucket k p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Bucket k p a -> a
$cfoldl1 :: forall k p a. (a -> a -> a) -> Bucket k p a -> a
foldr1 :: forall a. (a -> a -> a) -> Bucket k p a -> a
$cfoldr1 :: forall k p a. (a -> a -> a) -> Bucket k p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Bucket k p a -> b
$cfoldl' :: forall k p b a. (b -> a -> b) -> b -> Bucket k p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Bucket k p a -> b
$cfoldl :: forall k p b a. (b -> a -> b) -> b -> Bucket k p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Bucket k p a -> b
$cfoldr' :: forall k p a b. (a -> b -> b) -> b -> Bucket k p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Bucket k p a -> b
$cfoldr :: forall k p a b. (a -> b -> b) -> b -> Bucket k p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Bucket k p a -> m
$cfoldMap' :: forall k p m a. Monoid m => (a -> m) -> Bucket k p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Bucket k p a -> m
$cfoldMap :: forall k p m a. Monoid m => (a -> m) -> Bucket k p a -> m
fold :: forall m. Monoid m => Bucket k p m -> m
$cfold :: forall k p m. Monoid m => Bucket k p m -> m
Foldable, forall a b. a -> Bucket k p b -> Bucket k p a
forall a b. (a -> b) -> Bucket k p a -> Bucket k p b
forall k p a b. a -> Bucket k p b -> Bucket k p a
forall k p a b. (a -> b) -> Bucket k p a -> Bucket k p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Bucket k p b -> Bucket k p a
$c<$ :: forall k p a b. a -> Bucket k p b -> Bucket k p a
fmap :: forall a b. (a -> b) -> Bucket k p a -> Bucket k p b
$cfmap :: forall k p a b. (a -> b) -> Bucket k p a -> Bucket k p b
Functor, Int -> Bucket k p v -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k p v.
(Show k, Show v, Show p) =>
Int -> Bucket k p v -> ShowS
forall k p v. (Show k, Show v, Show p) => [Bucket k p v] -> ShowS
forall k p v. (Show k, Show v, Show p) => Bucket k p v -> String
showList :: [Bucket k p v] -> ShowS
$cshowList :: forall k p v. (Show k, Show v, Show p) => [Bucket k p v] -> ShowS
show :: Bucket k p v -> String
$cshow :: forall k p v. (Show k, Show v, Show p) => Bucket k p v -> String
showsPrec :: Int -> Bucket k p v -> ShowS
$cshowsPrec :: forall k p v.
(Show k, Show v, Show p) =>
Int -> Bucket k p v -> ShowS
Show, forall k p. Functor (Bucket k p)
forall k p. Foldable (Bucket k p)
forall k p (m :: * -> *) a.
Monad m =>
Bucket k p (m a) -> m (Bucket k p a)
forall k p (f :: * -> *) a.
Applicative f =>
Bucket k p (f a) -> f (Bucket k p a)
forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bucket k p a -> m (Bucket k p b)
forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bucket k p a -> f (Bucket k p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bucket k p a -> f (Bucket k p b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Bucket k p (m a) -> m (Bucket k p a)
$csequence :: forall k p (m :: * -> *) a.
Monad m =>
Bucket k p (m a) -> m (Bucket k p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bucket k p a -> m (Bucket k p b)
$cmapM :: forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bucket k p a -> m (Bucket k p b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Bucket k p (f a) -> f (Bucket k p a)
$csequenceA :: forall k p (f :: * -> *) a.
Applicative f =>
Bucket k p (f a) -> f (Bucket k p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bucket k p a -> f (Bucket k p b)
$ctraverse :: forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bucket k p a -> f (Bucket k p b)
Traversable)

-- | Smart constructor which takes care of placing the minimum element directly
-- in the 'Bucket'.
{-# INLINABLE mkBucket #-}
mkBucket
    :: (Ord k, Ord p)
    => k -> p -> v -> OrdPSQ.OrdPSQ k p v -> (p, Bucket k p v)
mkBucket :: forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
k p
p v
x OrdPSQ k p v
opsq =
    -- TODO (jaspervdj): We could do an 'unsafeInsertNew' here for all call
    -- sites.
    case forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (p, Bucket k p v)
toBucket (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k p
p v
x OrdPSQ k p v
opsq) of
        Just (p, Bucket k p v)
bucket -> (p, Bucket k p v)
bucket
        Maybe (p, Bucket k p v)
Nothing     -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"mkBucket: internal error"

toBucket :: (Ord k, Ord p) => OrdPSQ.OrdPSQ k p v -> Maybe (p, Bucket k p v)
toBucket :: forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (p, Bucket k p v)
toBucket OrdPSQ k p v
opsq = case forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
OrdPSQ.minView OrdPSQ k p v
opsq of
    Just (k
k, p
p, v
x, OrdPSQ k p v
opsq') -> forall a. a -> Maybe a
Just (p
p, forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k v
x OrdPSQ k p v
opsq')
    Maybe (k, p, v, OrdPSQ k p v)
Nothing               -> forall a. Maybe a
Nothing

instance (NFData k, NFData p, NFData v) => NFData (Bucket k p v) where
    rnf :: Bucket k p v -> ()
rnf (B k
k v
v OrdPSQ k p v
x) = forall a. NFData a => a -> ()
rnf k
k seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf v
v seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf OrdPSQ k p v
x

-- | A priority search queue with keys of type @k@ and priorities of type @p@
-- and values of type @v@. It is strict in keys, priorities and values.
newtype HashPSQ k p v = HashPSQ (IntPSQ.IntPSQ p (Bucket k p v))
    deriving (forall a. HashPSQ k p a -> Bool
forall m a. Monoid m => (a -> m) -> HashPSQ k p a -> m
forall a b. (a -> b -> b) -> b -> HashPSQ k p a -> b
forall k p a. Eq a => a -> HashPSQ k p a -> Bool
forall k p a. Num a => HashPSQ k p a -> a
forall k p a. Ord a => HashPSQ k p a -> a
forall k p m. Monoid m => HashPSQ k p m -> m
forall k p a. HashPSQ k p a -> Bool
forall k p a. HashPSQ k p a -> Int
forall k p a. HashPSQ k p a -> [a]
forall k p a. (a -> a -> a) -> HashPSQ k p a -> a
forall k p m a. Monoid m => (a -> m) -> HashPSQ k p a -> m
forall k p b a. (b -> a -> b) -> b -> HashPSQ k p a -> b
forall k p a b. (a -> b -> b) -> b -> HashPSQ k p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => HashPSQ k p a -> a
$cproduct :: forall k p a. Num a => HashPSQ k p a -> a
sum :: forall a. Num a => HashPSQ k p a -> a
$csum :: forall k p a. Num a => HashPSQ k p a -> a
minimum :: forall a. Ord a => HashPSQ k p a -> a
$cminimum :: forall k p a. Ord a => HashPSQ k p a -> a
maximum :: forall a. Ord a => HashPSQ k p a -> a
$cmaximum :: forall k p a. Ord a => HashPSQ k p a -> a
elem :: forall a. Eq a => a -> HashPSQ k p a -> Bool
$celem :: forall k p a. Eq a => a -> HashPSQ k p a -> Bool
length :: forall a. HashPSQ k p a -> Int
$clength :: forall k p a. HashPSQ k p a -> Int
null :: forall a. HashPSQ k p a -> Bool
$cnull :: forall k p a. HashPSQ k p a -> Bool
toList :: forall a. HashPSQ k p a -> [a]
$ctoList :: forall k p a. HashPSQ k p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> HashPSQ k p a -> a
$cfoldl1 :: forall k p a. (a -> a -> a) -> HashPSQ k p a -> a
foldr1 :: forall a. (a -> a -> a) -> HashPSQ k p a -> a
$cfoldr1 :: forall k p a. (a -> a -> a) -> HashPSQ k p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> HashPSQ k p a -> b
$cfoldl' :: forall k p b a. (b -> a -> b) -> b -> HashPSQ k p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HashPSQ k p a -> b
$cfoldl :: forall k p b a. (b -> a -> b) -> b -> HashPSQ k p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HashPSQ k p a -> b
$cfoldr' :: forall k p a b. (a -> b -> b) -> b -> HashPSQ k p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HashPSQ k p a -> b
$cfoldr :: forall k p a b. (a -> b -> b) -> b -> HashPSQ k p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> HashPSQ k p a -> m
$cfoldMap' :: forall k p m a. Monoid m => (a -> m) -> HashPSQ k p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HashPSQ k p a -> m
$cfoldMap :: forall k p m a. Monoid m => (a -> m) -> HashPSQ k p a -> m
fold :: forall m. Monoid m => HashPSQ k p m -> m
$cfold :: forall k p m. Monoid m => HashPSQ k p m -> m
Foldable, forall a b. a -> HashPSQ k p b -> HashPSQ k p a
forall a b. (a -> b) -> HashPSQ k p a -> HashPSQ k p b
forall k p a b. a -> HashPSQ k p b -> HashPSQ k p a
forall k p a b. (a -> b) -> HashPSQ k p a -> HashPSQ k p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HashPSQ k p b -> HashPSQ k p a
$c<$ :: forall k p a b. a -> HashPSQ k p b -> HashPSQ k p a
fmap :: forall a b. (a -> b) -> HashPSQ k p a -> HashPSQ k p b
$cfmap :: forall k p a b. (a -> b) -> HashPSQ k p a -> HashPSQ k p b
Functor, HashPSQ k p v -> ()
forall a. (a -> ()) -> NFData a
forall k p v. (NFData p, NFData k, NFData v) => HashPSQ k p v -> ()
rnf :: HashPSQ k p v -> ()
$crnf :: forall k p v. (NFData p, NFData k, NFData v) => HashPSQ k p v -> ()
NFData, Int -> HashPSQ k p v -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k p v.
(Show p, Show k, Show v) =>
Int -> HashPSQ k p v -> ShowS
forall k p v. (Show p, Show k, Show v) => [HashPSQ k p v] -> ShowS
forall k p v. (Show p, Show k, Show v) => HashPSQ k p v -> String
showList :: [HashPSQ k p v] -> ShowS
$cshowList :: forall k p v. (Show p, Show k, Show v) => [HashPSQ k p v] -> ShowS
show :: HashPSQ k p v -> String
$cshow :: forall k p v. (Show p, Show k, Show v) => HashPSQ k p v -> String
showsPrec :: Int -> HashPSQ k p v -> ShowS
$cshowsPrec :: forall k p v.
(Show p, Show k, Show v) =>
Int -> HashPSQ k p v -> ShowS
Show, forall k p. Functor (HashPSQ k p)
forall k p. Foldable (HashPSQ k p)
forall k p (m :: * -> *) a.
Monad m =>
HashPSQ k p (m a) -> m (HashPSQ k p a)
forall k p (f :: * -> *) a.
Applicative f =>
HashPSQ k p (f a) -> f (HashPSQ k p a)
forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HashPSQ k p a -> m (HashPSQ k p b)
forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashPSQ k p a -> f (HashPSQ k p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashPSQ k p a -> f (HashPSQ k p b)
sequence :: forall (m :: * -> *) a.
Monad m =>
HashPSQ k p (m a) -> m (HashPSQ k p a)
$csequence :: forall k p (m :: * -> *) a.
Monad m =>
HashPSQ k p (m a) -> m (HashPSQ k p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HashPSQ k p a -> m (HashPSQ k p b)
$cmapM :: forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HashPSQ k p a -> m (HashPSQ k p b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HashPSQ k p (f a) -> f (HashPSQ k p a)
$csequenceA :: forall k p (f :: * -> *) a.
Applicative f =>
HashPSQ k p (f a) -> f (HashPSQ k p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashPSQ k p a -> f (HashPSQ k p b)
$ctraverse :: forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashPSQ k p a -> f (HashPSQ k p b)
Traversable)

instance (Eq k, Eq p, Eq v, Hashable k, Ord k, Ord p) =>
            Eq (HashPSQ k p v) where
    HashPSQ k p v
x == :: HashPSQ k p v -> HashPSQ k p v -> Bool
== HashPSQ k p v
y = case (forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> Maybe (k, p, v, HashPSQ k p v)
minView HashPSQ k p v
x, forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> Maybe (k, p, v, HashPSQ k p v)
minView HashPSQ k p v
y) of
        (Maybe (k, p, v, HashPSQ k p v)
Nothing              , Maybe (k, p, v, HashPSQ k p v)
Nothing                ) -> Bool
True
        (Just (k
xk, p
xp, v
xv, HashPSQ k p v
x'), (Just (k
yk, p
yp, v
yv, HashPSQ k p v
y'))) ->
            k
xk forall a. Eq a => a -> a -> Bool
== k
yk Bool -> Bool -> Bool
&& p
xp forall a. Eq a => a -> a -> Bool
== p
yp Bool -> Bool -> Bool
&& v
xv forall a. Eq a => a -> a -> Bool
== v
yv Bool -> Bool -> Bool
&& HashPSQ k p v
x' forall a. Eq a => a -> a -> Bool
== HashPSQ k p v
y'
        (Just (k, p, v, HashPSQ k p v)
_               , Maybe (k, p, v, HashPSQ k p v)
Nothing                ) -> Bool
False
        (Maybe (k, p, v, HashPSQ k p v)
Nothing              , Just (k, p, v, HashPSQ k p v)
_                 ) -> Bool
False


------------------------------------------------------------------------------
-- Query
------------------------------------------------------------------------------

-- | /O(1)/ True if the queue is empty.
{-# INLINABLE null #-}
null :: HashPSQ k p v -> Bool
null :: forall k p a. HashPSQ k p a -> Bool
null (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = forall p v. IntPSQ p v -> Bool
IntPSQ.null IntPSQ p (Bucket k p v)
ipsq

-- | /O(n)/ The number of elements stored in the PSQ.
{-# INLINABLE size #-}
size :: HashPSQ k p v -> Int
size :: forall k p a. HashPSQ k p a -> Int
size (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = forall p v a. (Int -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
IntPSQ.fold'
    (\Int
_ p
_ (B k
_ v
_ OrdPSQ k p v
opsq) Int
acc -> Int
1 forall a. Num a => a -> a -> a
+ forall k p v. OrdPSQ k p v -> Int
OrdPSQ.size OrdPSQ k p v
opsq forall a. Num a => a -> a -> a
+ Int
acc)
    Int
0
    IntPSQ p (Bucket k p v)
ipsq

-- | /O(min(n,W))/ Check if a key is present in the the queue.
{-# INLINABLE member #-}
member :: (Hashable k, Ord k, Ord p) => k -> HashPSQ k p v -> Bool
member :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> Bool
member k
k = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v)
lookup k
k

-- | /O(min(n,W))/ The priority and value of a given key, or 'Nothing' if the
-- key is not bound.
{-# INLINABLE lookup #-}
lookup :: (Ord k, Hashable k, Ord p) => k -> HashPSQ k p v -> Maybe (p, v)
lookup :: forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v)
lookup k
k (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = do
    (p
p0, B k
k0 v
v0 OrdPSQ k p v
os) <- forall p v. Int -> IntPSQ p v -> Maybe (p, v)
IntPSQ.lookup (forall a. Hashable a => a -> Int
hash k
k) IntPSQ p (Bucket k p v)
ipsq
    if k
k0 forall a. Eq a => a -> a -> Bool
== k
k
        then forall (m :: * -> *) a. Monad m => a -> m a
return (p
p0, v
v0)
        else forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
OrdPSQ.lookup k
k OrdPSQ k p v
os

-- | /O(1)/ The element with the lowest priority.
findMin :: (Hashable k, Ord k, Ord p) => HashPSQ k p v -> Maybe (k, p, v)
findMin :: forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> Maybe (k, p, v)
findMin (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = case forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v)
IntPSQ.findMin IntPSQ p (Bucket k p v)
ipsq of
    Maybe (Int, p, Bucket k p v)
Nothing              -> forall a. Maybe a
Nothing
    Just (Int
_, p
p, B k
k v
x OrdPSQ k p v
_) -> forall a. a -> Maybe a
Just (k
k, p
p, v
x)


--------------------------------------------------------------------------------
-- Construction
--------------------------------------------------------------------------------

-- | /O(1)/ The empty queue.
empty :: HashPSQ k p v
empty :: forall k p v. HashPSQ k p v
empty = forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ forall p v. IntPSQ p v
IntPSQ.empty

-- | /O(1)/ Build a queue with one element.
singleton :: (Hashable k, Ord k, Ord p) => k -> p -> v -> HashPSQ k p v
singleton :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> p -> v -> HashPSQ k p v
singleton k
k p
p v
v = forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert k
k p
p v
v forall k p v. HashPSQ k p v
empty


--------------------------------------------------------------------------------
-- Insertion
--------------------------------------------------------------------------------

-- | /O(min(n,W))/ Insert a new key, priority and value into the queue. If the key
-- is already present in the queue, the associated priority and value are
-- replaced with the supplied priority and value.
{-# INLINABLE insert #-}
insert
    :: (Ord k, Hashable k, Ord p)
    => k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert :: forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert k
k p
p v
v (HashPSQ IntPSQ p (Bucket k p v)
ipsq) =
    case forall p v b.
Ord p =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> Int -> IntPSQ p v -> (b, IntPSQ p v)
IntPSQ.alter (\Maybe (p, Bucket k p v)
x -> ((), Maybe (p, Bucket k p v) -> Maybe (p, Bucket k p v)
ins Maybe (p, Bucket k p v)
x)) (forall a. Hashable a => a -> Int
hash k
k) IntPSQ p (Bucket k p v)
ipsq of
        ((), IntPSQ p (Bucket k p v)
ipsq') -> forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq'
  where
    ins :: Maybe (p, Bucket k p v) -> Maybe (p, Bucket k p v)
ins Maybe (p, Bucket k p v)
Nothing                         = forall a. a -> Maybe a
Just (p
p,  forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k  v
v  (forall k p v. OrdPSQ k p v
OrdPSQ.empty))
    ins (Just (p
p', B k
k' v
v' OrdPSQ k p v
os))
        | k
k' forall a. Eq a => a -> a -> Bool
== k
k                       =
            -- Tricky: p might have less priority than an item in 'os'.
            forall a. a -> Maybe a
Just (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
k p
p v
v OrdPSQ k p v
os)
        | p
p' forall a. Ord a => a -> a -> Bool
< p
p Bool -> Bool -> Bool
|| (p
p forall a. Eq a => a -> a -> Bool
== p
p' Bool -> Bool -> Bool
&& k
k' forall a. Ord a => a -> a -> Bool
< k
k) =
            forall a. a -> Maybe a
Just (p
p', forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k' v
v' (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k  p
p  v
v  OrdPSQ k p v
os))
        | forall k p v. Ord k => k -> OrdPSQ k p v -> Bool
OrdPSQ.member k
k OrdPSQ k p v
os            =
            -- This is a bit tricky: k might already be present in 'os' and we
            -- don't want to end up with duplicate keys.
            forall a. a -> Maybe a
Just (p
p,  forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k  v
v  (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k' p
p' v
v' (forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.delete k
k OrdPSQ k p v
os)))
        | Bool
otherwise                     =
            forall a. a -> Maybe a
Just (p
p , forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k  v
v  (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k' p
p' v
v' OrdPSQ k p v
os))


--------------------------------------------------------------------------------
-- Delete/update
--------------------------------------------------------------------------------

-- | /O(min(n,W))/ Delete a key and its priority and value from the queue. When
-- the key is not a member of the queue, the original queue is returned.
{-# INLINE delete #-}
delete
    :: (Hashable k, Ord k, Ord p) => k -> HashPSQ k p v -> HashPSQ k p v
delete :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> HashPSQ k p v
delete k
k HashPSQ k p v
t = case forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
deleteView k
k HashPSQ k p v
t of
    Maybe (p, v, HashPSQ k p v)
Nothing         -> HashPSQ k p v
t
    Just (p
_, v
_, HashPSQ k p v
t') -> HashPSQ k p v
t'

-- | /O(min(n,W))/ Delete the binding with the least priority, and return the
-- rest of the queue stripped of that binding. In case the queue is empty, the
-- empty queue is returned again.
{-# INLINE deleteMin #-}
deleteMin
    :: (Hashable k, Ord k, Ord p) => HashPSQ k p v -> HashPSQ k p v
deleteMin :: forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> HashPSQ k p v
deleteMin HashPSQ k p v
t = case forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> Maybe (k, p, v, HashPSQ k p v)
minView HashPSQ k p v
t of
    Maybe (k, p, v, HashPSQ k p v)
Nothing            -> HashPSQ k p v
t
    Just (k
_, p
_, v
_, HashPSQ k p v
t') -> HashPSQ k p v
t'

-- | /O(min(n,W))/ The expression @alter f k queue@ alters the value @x@ at @k@,
-- or absence thereof. 'alter' can be used to insert, delete, or update a value
-- in a queue. It also allows you to calculate an additional value @b@.
{-# INLINABLE alter #-}
alter :: (Hashable k, Ord k, Ord p)
      => (Maybe (p, v) -> (b, Maybe (p, v)))
      -> k -> HashPSQ k p v -> (b, HashPSQ k p v)
alter :: forall k p v b.
(Hashable k, Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> HashPSQ k p v -> (b, HashPSQ k p v)
alter Maybe (p, v) -> (b, Maybe (p, v))
f k
k (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = case forall p v. Ord p => Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
IntPSQ.deleteView Int
h IntPSQ p (Bucket k p v)
ipsq of
    Maybe (p, Bucket k p v, IntPSQ p (Bucket k p v))
Nothing -> case Maybe (p, v) -> (b, Maybe (p, v))
f forall a. Maybe a
Nothing of
        (b
b, Maybe (p, v)
Nothing)     -> (b
b, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq)
        (b
b, Just (p
p, v
x)) ->
            (b
b, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ forall a b. (a -> b) -> a -> b
$ forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertNew Int
h p
p (forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k v
x forall k p v. OrdPSQ k p v
OrdPSQ.empty) IntPSQ p (Bucket k p v)
ipsq)
    Just (p
bp, B k
bk v
bx OrdPSQ k p v
opsq, IntPSQ p (Bucket k p v)
ipsq')
        | k
k forall a. Eq a => a -> a -> Bool
== k
bk   -> case Maybe (p, v) -> (b, Maybe (p, v))
f (forall a. a -> Maybe a
Just (p
bp, v
bx)) of
            (b
b, Maybe (p, v)
Nothing) -> case forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (p, Bucket k p v)
toBucket OrdPSQ k p v
opsq of
                Maybe (p, Bucket k p v)
Nothing             -> (b
b, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq')
                Just (p
bp', Bucket k p v
bucket') ->
                    (b
b, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ forall a b. (a -> b) -> a -> b
$ forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertNew Int
h p
bp' Bucket k p v
bucket' IntPSQ p (Bucket k p v)
ipsq')
            (b
b, Just (p
p, v
x)) -> case forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
k p
p v
x OrdPSQ k p v
opsq of
                (p
bp', Bucket k p v
bucket') ->
                    (b
b, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ forall a b. (a -> b) -> a -> b
$ forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertNew Int
h p
bp' Bucket k p v
bucket' IntPSQ p (Bucket k p v)
ipsq')
        | Bool
otherwise -> case forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
OrdPSQ.alter Maybe (p, v) -> (b, Maybe (p, v))
f k
k OrdPSQ k p v
opsq of
            (b
b, OrdPSQ k p v
opsq') -> case forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
bk p
bp v
bx OrdPSQ k p v
opsq' of
                (p
bp', Bucket k p v
bucket') ->
                    (b
b, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ forall a b. (a -> b) -> a -> b
$ forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertNew Int
h p
bp' Bucket k p v
bucket' IntPSQ p (Bucket k p v)
ipsq')
  where
    h :: Int
h = forall a. Hashable a => a -> Int
hash k
k

-- | /O(min(n,W))/ A variant of 'alter' which works on the element with the
-- minimum priority. Unlike 'alter', this variant also allows you to change the
-- key of the element.
{-# INLINABLE alterMin #-}
alterMin
    :: (Hashable k, Ord k, Ord p)
     => (Maybe (k, p, v) -> (b, Maybe (k, p, v)))
     -> HashPSQ k p v
     -> (b, HashPSQ k p v)
alterMin :: forall k p v b.
(Hashable k, Ord k, Ord p) =>
(Maybe (k, p, v) -> (b, Maybe (k, p, v)))
-> HashPSQ k p v -> (b, HashPSQ k p v)
alterMin Maybe (k, p, v) -> (b, Maybe (k, p, v))
f HashPSQ k p v
t0 =
    let (HashPSQ k p v
t, Maybe (k, p, v)
mbX) = case forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> Maybe (k, p, v, HashPSQ k p v)
minView HashPSQ k p v
t0 of
                    Maybe (k, p, v, HashPSQ k p v)
Nothing             -> (HashPSQ k p v
t0, forall a. Maybe a
Nothing)
                    Just (k
k, p
p, v
x, HashPSQ k p v
t0') -> (HashPSQ k p v
t0', forall a. a -> Maybe a
Just (k
k, p
p, v
x))
    in case Maybe (k, p, v) -> (b, Maybe (k, p, v))
f Maybe (k, p, v)
mbX of
        (b
b, Maybe (k, p, v)
mbX') ->
            (b
b, forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashPSQ k p v
t (\(k
k, p
p, v
x) -> forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert k
k p
p v
x HashPSQ k p v
t) Maybe (k, p, v)
mbX')


--------------------------------------------------------------------------------
-- Lists
--------------------------------------------------------------------------------

-- | /O(n*min(n,W))/ Build a queue from a list of (key, priority, value) tuples.
-- If the list contains more than one priority and value for the same key, the
-- last priority and value for the key is retained.
{-# INLINABLE fromList #-}
fromList :: (Hashable k, Ord k, Ord p) => [(k, p, v)] -> HashPSQ k p v
fromList :: forall k p v.
(Hashable k, Ord k, Ord p) =>
[(k, p, v)] -> HashPSQ k p v
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\HashPSQ k p v
psq (k
k, p
p, v
x) -> forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert k
k p
p v
x HashPSQ k p v
psq) forall k p v. HashPSQ k p v
empty

-- | /O(n)/ Convert a queue to a list of (key, priority, value) tuples. The
-- order of the list is not specified.
{-# INLINABLE toList #-}
toList :: (Hashable k, Ord k, Ord p) => HashPSQ k p v -> [(k, p, v)]
toList :: forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> [(k, p, v)]
toList (HashPSQ IntPSQ p (Bucket k p v)
ipsq) =
    [ (k
k', p
p', v
x')
    | (Int
_, p
p, (B k
k v
x OrdPSQ k p v
opsq)) <- forall p v. IntPSQ p v -> [(Int, p, v)]
IntPSQ.toList IntPSQ p (Bucket k p v)
ipsq
    , (k
k', p
p', v
x')         <- (k
k, p
p, v
x) forall a. a -> [a] -> [a]
: forall k p v. OrdPSQ k p v -> [(k, p, v)]
OrdPSQ.toList OrdPSQ k p v
opsq
    ]

-- | /O(n)/ Obtain the list of present keys in the queue.
{-# INLINABLE keys #-}
keys :: (Hashable k, Ord k, Ord p) => HashPSQ k p v -> [k]
keys :: forall k p v. (Hashable k, Ord k, Ord p) => HashPSQ k p v -> [k]
keys HashPSQ k p v
t = [k
k | (k
k, p
_, v
_) <- forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> [(k, p, v)]
toList HashPSQ k p v
t]


--------------------------------------------------------------------------------
-- Views
--------------------------------------------------------------------------------

-- | /O(min(n,W))/ Insert a new key, priority and value into the queue. If the key
-- is already present in the queue, then the evicted priority and value can be
-- found the first element of the returned tuple.
{-# INLINABLE insertView #-}
insertView
    :: (Hashable k, Ord k, Ord p)
    => k -> p -> v -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
insertView :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
insertView k
k p
p v
x HashPSQ k p v
t =
    -- TODO (jaspervdj): Can be optimized easily
    case forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
deleteView k
k HashPSQ k p v
t of
        Maybe (p, v, HashPSQ k p v)
Nothing          -> (forall a. Maybe a
Nothing,       forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert k
k p
p v
x HashPSQ k p v
t)
        Just (p
p', v
x', HashPSQ k p v
_) -> (forall a. a -> Maybe a
Just (p
p', v
x'), forall k p v.
(Ord k, Hashable k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
insert k
k p
p v
x HashPSQ k p v
t)

-- | /O(min(n,W))/ Delete a key and its priority and value from the queue. If
-- the key was present, the associated priority and value are returned in
-- addition to the updated queue.
{-# INLINABLE deleteView #-}
deleteView
    :: forall k p v. (Hashable k, Ord k, Ord p)
    => k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
deleteView :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
deleteView k
k (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = case forall p v b.
Ord p =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> Int -> IntPSQ p v -> (b, IntPSQ p v)
IntPSQ.alter Maybe (p, Bucket k p v) -> (Maybe (p, v), Maybe (p, Bucket k p v))
f (forall a. Hashable a => a -> Int
hash k
k) IntPSQ p (Bucket k p v)
ipsq of
    (Maybe (p, v)
Nothing,     IntPSQ p (Bucket k p v)
_    ) -> forall a. Maybe a
Nothing
    (Just (p
p, v
x), IntPSQ p (Bucket k p v)
ipsq') -> forall a. a -> Maybe a
Just (p
p, v
x, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq')
  where
    f :: Maybe (p, Bucket k p v) -> (Maybe (p, v), Maybe (p, Bucket k p v))
    f :: Maybe (p, Bucket k p v) -> (Maybe (p, v), Maybe (p, Bucket k p v))
f Maybe (p, Bucket k p v)
Nothing       = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
    f (Just (p
p, B k
bk v
bx OrdPSQ k p v
opsq))
        | k
k forall a. Eq a => a -> a -> Bool
== k
bk   = case forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
OrdPSQ.minView OrdPSQ k p v
opsq of
            Maybe (k, p, v, OrdPSQ k p v)
Nothing                  -> (forall a. a -> Maybe a
Just (p
p, v
bx), forall a. Maybe a
Nothing)
            Just (k
k', p
p', v
x', OrdPSQ k p v
opsq') -> (forall a. a -> Maybe a
Just (p
p, v
bx), forall a. a -> Maybe a
Just (p
p', forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k' v
x' OrdPSQ k p v
opsq'))
        | Bool
otherwise = case forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
OrdPSQ.deleteView k
k OrdPSQ k p v
opsq of
            Maybe (p, v, OrdPSQ k p v)
Nothing              -> (forall a. Maybe a
Nothing,       forall a. Maybe a
Nothing)
            Just (p
p', v
x', OrdPSQ k p v
opsq') -> (forall a. a -> Maybe a
Just (p
p', v
x'), forall a. a -> Maybe a
Just (p
p, forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
bk v
bx OrdPSQ k p v
opsq'))

-- | /O(min(n,W))/ Retrieve the binding with the least priority, and the
-- rest of the queue stripped of that binding.
{-# INLINABLE minView #-}
minView
    :: (Hashable k, Ord k, Ord p)
    => HashPSQ k p v -> Maybe (k, p, v, HashPSQ k p v)
minView :: forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> Maybe (k, p, v, HashPSQ k p v)
minView (HashPSQ IntPSQ p (Bucket k p v)
ipsq ) =
    case forall p v b.
Ord p =>
(Maybe (Int, p, v) -> (b, Maybe (Int, p, v)))
-> IntPSQ p v -> (b, IntPSQ p v)
IntPSQ.alterMin forall {k} {p} {a} {b} {v}.
(Ord k, Ord p) =>
Maybe (a, b, Bucket k p v)
-> (Maybe (k, b, v), Maybe (a, p, Bucket k p v))
f IntPSQ p (Bucket k p v)
ipsq of
        (Maybe (k, p, v)
Nothing       , IntPSQ p (Bucket k p v)
_    ) -> forall a. Maybe a
Nothing
        (Just (k
k, p
p, v
x), IntPSQ p (Bucket k p v)
ipsq') -> forall a. a -> Maybe a
Just (k
k, p
p, v
x, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq')
  where
    f :: Maybe (a, b, Bucket k p v)
-> (Maybe (k, b, v), Maybe (a, p, Bucket k p v))
f Maybe (a, b, Bucket k p v)
Nothing                 = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
    f (Just (a
h, b
p, B k
k v
x OrdPSQ k p v
os)) = case forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
OrdPSQ.minView OrdPSQ k p v
os of
        Maybe (k, p, v, OrdPSQ k p v)
Nothing                ->
            (forall a. a -> Maybe a
Just (k
k, b
p, v
x), forall a. Maybe a
Nothing)
        Just (k
k', p
p', v
x', OrdPSQ k p v
os') ->
            (forall a. a -> Maybe a
Just (k
k, b
p, v
x), forall a. a -> Maybe a
Just (a
h, p
p', forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k' v
x' OrdPSQ k p v
os'))

-- | Return a list of elements ordered by key whose priorities are at most @pt@,
-- and the rest of the queue stripped of these elements.  The returned list of
-- elements can be in any order: no guarantees there.
{-# INLINABLE atMostView #-}
atMostView
    :: (Hashable k, Ord k, Ord p)
    => p -> HashPSQ k p v -> ([(k, p, v)], HashPSQ k p v)
atMostView :: forall k p v.
(Hashable k, Ord k, Ord p) =>
p -> HashPSQ k p v -> ([(k, p, v)], HashPSQ k p v)
atMostView p
pt (HashPSQ IntPSQ p (Bucket k p v)
t0) =
    ([(k, p, v)]
returns, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
t2)
  where
    -- First we use 'IntPSQ.atMostView' to get a collection of buckets that have
    -- /AT LEAST/ one element with a low priority.  Buckets will usually only
    -- contain a single element.
    ([(Int, p, Bucket k p v)]
buckets, IntPSQ p (Bucket k p v)
t1) = forall p v. Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
IntPSQ.atMostView p
pt IntPSQ p (Bucket k p v)
t0

    -- We now need to run through the buckets.  This will give us a list of
    -- elements to return and a bunch of buckets to re-insert.
    ([(k, p, v)]
returns, [(p, Bucket k p v)]
reinserts) = forall {k} {v} {a}.
Ord k =>
[(k, p, v)]
-> [(p, Bucket k p v)]
-> [(a, p, Bucket k p v)]
-> ([(k, p, v)], [(p, Bucket k p v)])
go [] [] [(Int, p, Bucket k p v)]
buckets
      where
        -- We use two accumulators, for returns and re-inserts.
        go :: [(k, p, v)]
-> [(p, Bucket k p v)]
-> [(a, p, Bucket k p v)]
-> ([(k, p, v)], [(p, Bucket k p v)])
go [(k, p, v)]
rets [(p, Bucket k p v)]
reins []                        = ([(k, p, v)]
rets, [(p, Bucket k p v)]
reins)
        go [(k, p, v)]
rets [(p, Bucket k p v)]
reins ((a
_, p
p, B k
k v
v OrdPSQ k p v
opsq) : [(a, p, Bucket k p v)]
bs) =
            -- Note that 'elems' should be very small, ideally a null list.
            let ([(k, p, v)]
elems, OrdPSQ k p v
opsq') = forall k p v.
(Ord k, Ord p) =>
p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
OrdPSQ.atMostView p
pt OrdPSQ k p v
opsq
                rets' :: [(k, p, v)]
rets'          = (k
k, p
p, v
v) forall a. a -> [a] -> [a]
: [(k, p, v)]
elems forall a. [a] -> [a] -> [a]
++ [(k, p, v)]
rets
                reins' :: [(p, Bucket k p v)]
reins'         = case forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (p, Bucket k p v)
toBucket OrdPSQ k p v
opsq' of
                    Maybe (p, Bucket k p v)
Nothing      -> [(p, Bucket k p v)]
reins
                    Just (p
p', Bucket k p v
b) -> ((p
p', Bucket k p v
b) forall a. a -> [a] -> [a]
: [(p, Bucket k p v)]
reins)
            in  [(k, p, v)]
-> [(p, Bucket k p v)]
-> [(a, p, Bucket k p v)]
-> ([(k, p, v)], [(p, Bucket k p v)])
go [(k, p, v)]
rets' [(p, Bucket k p v)]
reins' [(a, p, Bucket k p v)]
bs

    -- Now we can do the re-insertion pass.
    t2 :: IntPSQ p (Bucket k p v)
t2 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
        (\IntPSQ p (Bucket k p v)
t (p
p, b :: Bucket k p v
b@(B k
k v
_ OrdPSQ k p v
_)) -> forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertNew (forall a. Hashable a => a -> Int
hash k
k) p
p Bucket k p v
b IntPSQ p (Bucket k p v)
t)
        IntPSQ p (Bucket k p v)
t1
        [(p, Bucket k p v)]
reinserts


--------------------------------------------------------------------------------
-- Traversals
--------------------------------------------------------------------------------

-- | /O(n)/ Modify every value in the queue.
{-# INLINABLE map #-}
map :: (k -> p -> v -> w) -> HashPSQ k p v -> HashPSQ k p w
map :: forall k p v w.
(k -> p -> v -> w) -> HashPSQ k p v -> HashPSQ k p w
map k -> p -> v -> w
f (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ (forall p v w. (Int -> p -> v -> w) -> IntPSQ p v -> IntPSQ p w
IntPSQ.map (\Int
_ p
p Bucket k p v
v -> p -> Bucket k p v -> Bucket k p w
mapBucket p
p Bucket k p v
v) IntPSQ p (Bucket k p v)
ipsq)
  where
    mapBucket :: p -> Bucket k p v -> Bucket k p w
mapBucket p
p (B k
k v
v OrdPSQ k p v
opsq) = forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k (k -> p -> v -> w
f k
k p
p v
v) (forall k p v w. (k -> p -> v -> w) -> OrdPSQ k p v -> OrdPSQ k p w
OrdPSQ.map k -> p -> v -> w
f OrdPSQ k p v
opsq)

-- | /O(n)/ Maps a function over the values and priorities of the queue.
-- The function @f@ must be monotonic with respect to the priorities. I.e. if
-- @x < y@, then @fst (f k x v) < fst (f k y v)@.
-- /The precondition is not checked./ If @f@ is not monotonic, then the result
-- will be invalid.
{-# INLINABLE unsafeMapMonotonic #-}
unsafeMapMonotonic
    :: (k -> p -> v -> (q, w))
    -> HashPSQ k p v
    -> HashPSQ k q w
unsafeMapMonotonic :: forall k p v q w.
(k -> p -> v -> (q, w)) -> HashPSQ k p v -> HashPSQ k q w
unsafeMapMonotonic k -> p -> v -> (q, w)
f (HashPSQ IntPSQ p (Bucket k p v)
ipsq) =
  forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ (forall p v q w.
(Int -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w
IntPSQ.unsafeMapMonotonic (\Int
_ p
p Bucket k p v
v -> p -> Bucket k p v -> (q, Bucket k q w)
mapBucket p
p Bucket k p v
v) IntPSQ p (Bucket k p v)
ipsq)
  where
    mapBucket :: p -> Bucket k p v -> (q, Bucket k q w)
mapBucket p
p (B k
k v
v OrdPSQ k p v
opsq) =
        let (q
p', w
v') = k -> p -> v -> (q, w)
f k
k p
p v
v
        in  (q
p', forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k w
v' (forall k p q v w.
(k -> p -> v -> (q, w)) -> OrdPSQ k p v -> OrdPSQ k q w
OrdPSQ.unsafeMapMonotonic k -> p -> v -> (q, w)
f OrdPSQ k p v
opsq))

-- | /O(n)/ Strict fold over every key, priority and value in the queue. The order
-- in which the fold is performed is not specified.
{-# INLINABLE fold' #-}
fold' :: (k -> p -> v -> a -> a) -> a -> HashPSQ k p v -> a
fold' :: forall k p v a. (k -> p -> v -> a -> a) -> a -> HashPSQ k p v -> a
fold' k -> p -> v -> a -> a
f a
acc0 (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = forall p v a. (Int -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
IntPSQ.fold' forall {p}. p -> p -> Bucket k p v -> a -> a
goBucket a
acc0 IntPSQ p (Bucket k p v)
ipsq
  where
    goBucket :: p -> p -> Bucket k p v -> a -> a
goBucket p
_ p
p (B k
k v
v OrdPSQ k p v
opsq) a
acc =
        let !acc1 :: a
acc1 = k -> p -> v -> a -> a
f k
k p
p v
v a
acc
            !acc2 :: a
acc2 = forall k p v a. (k -> p -> v -> a -> a) -> a -> OrdPSQ k p v -> a
OrdPSQ.fold' k -> p -> v -> a -> a
f a
acc1 OrdPSQ k p v
opsq
        in a
acc2


--------------------------------------------------------------------------------
-- Unsafe operations
--------------------------------------------------------------------------------

{-# INLINABLE unsafeLookupIncreasePriority #-}
unsafeLookupIncreasePriority
    :: (Hashable k, Ord k, Ord p)
    => k -> p -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
unsafeLookupIncreasePriority :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> p -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
unsafeLookupIncreasePriority k
k p
p (HashPSQ IntPSQ p (Bucket k p v)
ipsq) =
    (Maybe (p, v)
mbPV, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq')
  where
    (!Maybe (p, v)
mbPV, !IntPSQ p (Bucket k p v)
ipsq') = forall p v b.
Ord p =>
(p -> v -> (Maybe b, p, v))
-> Int -> IntPSQ p v -> (Maybe b, IntPSQ p v)
IntPSQ.unsafeLookupIncreasePriority
        (\p
bp b :: Bucket k p v
b@(B k
bk v
bx OrdPSQ k p v
opsq) ->
            if k
k forall a. Eq a => a -> a -> Bool
== k
bk
                then let (p
bp', Bucket k p v
b') = forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
k p
p v
bx OrdPSQ k p v
opsq
                     in (forall a. a -> Maybe a
Just (p
bp, v
bx), p
bp', Bucket k p v
b')
                -- TODO (jaspervdj): Still a lookup-insert here: 3 traversals?
                else case forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
OrdPSQ.lookup k
k OrdPSQ k p v
opsq of
                        Maybe (p, v)
Nothing      -> (forall a. Maybe a
Nothing,     p
bp, Bucket k p v
b)
                        Just (p
p', v
x) ->
                            let b' :: Bucket k p v
b' = forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
bk v
bx (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k p
p v
x OrdPSQ k p v
opsq)
                            in (forall a. a -> Maybe a
Just (p
p', v
x), p
bp, Bucket k p v
b'))
        (forall a. Hashable a => a -> Int
hash k
k)
        IntPSQ p (Bucket k p v)
ipsq

{-# INLINABLE unsafeInsertIncreasePriority #-}
unsafeInsertIncreasePriority
    :: (Hashable k, Ord k, Ord p)
    => k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
unsafeInsertIncreasePriority :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> HashPSQ k p v
unsafeInsertIncreasePriority k
k p
p v
x (HashPSQ IntPSQ p (Bucket k p v)
ipsq) = forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ forall a b. (a -> b) -> a -> b
$
    forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.unsafeInsertWithIncreasePriority
        (\p
_ Bucket k p v
_ p
bp (B k
bk v
bx OrdPSQ k p v
opsq) ->
            if k
k forall a. Eq a => a -> a -> Bool
== k
bk
                then forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
k p
p v
x OrdPSQ k p v
opsq
                else (p
bp, forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
bk v
bx (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k p
p v
x OrdPSQ k p v
opsq)))
        (forall a. Hashable a => a -> Int
hash k
k)
        p
p
        (forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k v
x forall k p v. OrdPSQ k p v
OrdPSQ.empty)
        IntPSQ p (Bucket k p v)
ipsq

{-# INLINABLE unsafeInsertIncreasePriorityView #-}
unsafeInsertIncreasePriorityView
    :: (Hashable k, Ord k, Ord p)
    => k -> p -> v -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
unsafeInsertIncreasePriorityView :: forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
unsafeInsertIncreasePriorityView k
k p
p v
x (HashPSQ IntPSQ p (Bucket k p v)
ipsq) =
    (Maybe (p, v)
mbEvicted, forall k p v. IntPSQ p (Bucket k p v) -> HashPSQ k p v
HashPSQ IntPSQ p (Bucket k p v)
ipsq')
  where
    (Maybe (p, Bucket k p v)
mbBucket, IntPSQ p (Bucket k p v)
ipsq') = forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
IntPSQ.unsafeInsertWithIncreasePriorityView
        (\p
_ Bucket k p v
_ p
bp (B k
bk v
bx OrdPSQ k p v
opsq) ->
            if k
k forall a. Eq a => a -> a -> Bool
== k
bk
                then forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> (p, Bucket k p v)
mkBucket k
k p
p v
x OrdPSQ k p v
opsq
                else (p
bp, forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
bk v
bx (forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k p
p v
x OrdPSQ k p v
opsq)))
        (forall a. Hashable a => a -> Int
hash k
k)
        p
p
        (forall k p v. k -> v -> OrdPSQ k p v -> Bucket k p v
B k
k v
x forall k p v. OrdPSQ k p v
OrdPSQ.empty)
        IntPSQ p (Bucket k p v)
ipsq

    mbEvicted :: Maybe (p, v)
mbEvicted = case Maybe (p, Bucket k p v)
mbBucket of
        Maybe (p, Bucket k p v)
Nothing         -> forall a. Maybe a
Nothing
        Just (p
bp, B k
bk v
bv OrdPSQ k p v
opsq)
            | k
k forall a. Eq a => a -> a -> Bool
== k
bk   -> forall a. a -> Maybe a
Just (p
bp, v
bv)
            | Bool
otherwise -> forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
OrdPSQ.lookup k
k OrdPSQ k p v
opsq


--------------------------------------------------------------------------------
-- Validity check
--------------------------------------------------------------------------------

-- | /O(n^2)/ Internal function to check if the 'HashPSQ' is valid, i.e. if all
-- invariants hold. This should always be the case.
valid :: (Hashable k, Ord k, Ord p) => HashPSQ k p v -> Bool
valid :: forall k p v. (Hashable k, Ord k, Ord p) => HashPSQ k p v -> Bool
valid t :: HashPSQ k p v
t@(HashPSQ IntPSQ p (Bucket k p v)
ipsq) =
    Bool -> Bool
not (forall k p v. (Hashable k, Ord k, Ord p) => HashPSQ k p v -> Bool
hasDuplicateKeys HashPSQ k p v
t) Bool -> Bool -> Bool
&&
    forall (t :: * -> *). Foldable t => t Bool -> Bool
and [forall k p v.
(Hashable k, Ord k, Ord p) =>
Int -> p -> Bucket k p v -> Bool
validBucket Int
k p
p Bucket k p v
bucket | (Int
k, p
p, Bucket k p v
bucket) <- forall p v. IntPSQ p v -> [(Int, p, v)]
IntPSQ.toList IntPSQ p (Bucket k p v)
ipsq]

hasDuplicateKeys :: (Hashable k, Ord k, Ord p) => HashPSQ k p v -> Bool
hasDuplicateKeys :: forall k p v. (Hashable k, Ord k, Ord p) => HashPSQ k p v -> Bool
hasDuplicateKeys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
List.group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
List.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k p v. (Hashable k, Ord k, Ord p) => HashPSQ k p v -> [k]
keys

validBucket :: (Hashable k, Ord k, Ord p) => Int -> p -> Bucket k p v -> Bool
validBucket :: forall k p v.
(Hashable k, Ord k, Ord p) =>
Int -> p -> Bucket k p v -> Bool
validBucket Int
h p
p (B k
k v
_ OrdPSQ k p v
opsq) =
    forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
OrdPSQ.valid OrdPSQ k p v
opsq Bool -> Bool -> Bool
&&
    -- Check that the first element of the bucket has lower priority than all
    -- the other elements.
    forall (t :: * -> *). Foldable t => t Bool -> Bool
and [(p
p, k
k) forall a. Ord a => a -> a -> Bool
< (p
p', k
k') Bool -> Bool -> Bool
&& forall a. Hashable a => a -> Int
hash k
k' forall a. Eq a => a -> a -> Bool
== Int
h | (k
k', p
p', v
_) <- forall k p v. OrdPSQ k p v -> [(k, p, v)]
OrdPSQ.toList OrdPSQ k p v
opsq]