{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE StandaloneDeriving #-}
module Control.Distributed.Process.Extras.Internal.Queue.PriorityQ where

-- NB: we might try this with a skewed binomial heap at some point,
-- but for now, we'll use this module from the fingertree package
import qualified Data.PriorityQueue.FingerTree as PQ
import Data.PriorityQueue.FingerTree (PQueue)

newtype PriorityQ k a = PriorityQ { forall k a. PriorityQ k a -> PQueue k a
q :: PQueue k a }

{-# INLINE empty #-}
empty :: Ord k => PriorityQ k v
empty :: forall k v. Ord k => PriorityQ k v
empty = PQueue k v -> PriorityQ k v
forall k a. PQueue k a -> PriorityQ k a
PriorityQ (PQueue k v -> PriorityQ k v) -> PQueue k v -> PriorityQ k v
forall a b. (a -> b) -> a -> b
$ PQueue k v
forall k v. Ord k => PQueue k v
PQ.empty

{-# INLINE isEmpty #-}
isEmpty :: Ord k => PriorityQ k v -> Bool
isEmpty :: forall k v. Ord k => PriorityQ k v -> Bool
isEmpty = PQueue k v -> Bool
forall k v. Ord k => PQueue k v -> Bool
PQ.null (PQueue k v -> Bool)
-> (PriorityQ k v -> PQueue k v) -> PriorityQ k v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriorityQ k v -> PQueue k v
forall k a. PriorityQ k a -> PQueue k a
q

{-# INLINE singleton #-}
singleton :: Ord k => k -> a -> PriorityQ k a
singleton :: forall k a. Ord k => k -> a -> PriorityQ k a
singleton !k
k !a
v = PQueue k a -> PriorityQ k a
forall k a. PQueue k a -> PriorityQ k a
PriorityQ (PQueue k a -> PriorityQ k a) -> PQueue k a -> PriorityQ k a
forall a b. (a -> b) -> a -> b
$ k -> a -> PQueue k a
forall k v. Ord k => k -> v -> PQueue k v
PQ.singleton k
k a
v

{-# INLINE enqueue #-}
enqueue :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
enqueue :: forall k v. Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
enqueue !k
k !v
v PriorityQ k v
p = PQueue k v -> PriorityQ k v
forall k a. PQueue k a -> PriorityQ k a
PriorityQ (k -> v -> PQueue k v -> PQueue k v
forall k v. Ord k => k -> v -> PQueue k v -> PQueue k v
PQ.add k
k v
v (PQueue k v -> PQueue k v) -> PQueue k v -> PQueue k v
forall a b. (a -> b) -> a -> b
$ PriorityQ k v -> PQueue k v
forall k a. PriorityQ k a -> PQueue k a
q PriorityQ k v
p)

{-# INLINE dequeue #-}
dequeue :: Ord k => PriorityQ k v -> Maybe (v, PriorityQ k v)
dequeue :: forall k v. Ord k => PriorityQ k v -> Maybe (v, PriorityQ k v)
dequeue PriorityQ k v
p = Maybe (v, PriorityQ k v)
-> ((v, PriorityQ k v) -> Maybe (v, PriorityQ k v))
-> Maybe (v, PriorityQ k v)
-> Maybe (v, PriorityQ k v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (v, PriorityQ k v)
forall a. Maybe a
Nothing (\(v
v, PriorityQ k v
pq') -> (v, PriorityQ k v) -> Maybe (v, PriorityQ k v)
forall a. a -> Maybe a
Just (v
v, PriorityQ k v
pq')) (Maybe (v, PriorityQ k v) -> Maybe (v, PriorityQ k v))
-> Maybe (v, PriorityQ k v) -> Maybe (v, PriorityQ k v)
forall a b. (a -> b) -> a -> b
$
              case (PQueue k v -> Maybe (v, PQueue k v)
forall k v. Ord k => PQueue k v -> Maybe (v, PQueue k v)
PQ.minView (PriorityQ k v -> PQueue k v
forall k a. PriorityQ k a -> PQueue k a
q PriorityQ k v
p)) of
                Maybe (v, PQueue k v)
Nothing     -> Maybe (v, PriorityQ k v)
forall a. Maybe a
Nothing
                Just (v
v, PQueue k v
q') -> (v, PriorityQ k v) -> Maybe (v, PriorityQ k v)
forall a. a -> Maybe a
Just (v
v, PQueue k v -> PriorityQ k v
forall k a. PQueue k a -> PriorityQ k a
PriorityQ (PQueue k v -> PriorityQ k v) -> PQueue k v -> PriorityQ k v
forall a b. (a -> b) -> a -> b
$ PQueue k v
q')

{-# INLINE peek #-}
peek :: Ord k => PriorityQ k v -> Maybe v
peek :: forall k v. Ord k => PriorityQ k v -> Maybe v
peek PriorityQ k v
p = Maybe v
-> ((v, PriorityQ k v) -> Maybe v)
-> Maybe (v, PriorityQ k v)
-> Maybe v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe v
forall a. Maybe a
Nothing (\(v
v, PriorityQ k v
_) -> v -> Maybe v
forall a. a -> Maybe a
Just v
v) (Maybe (v, PriorityQ k v) -> Maybe v)
-> Maybe (v, PriorityQ k v) -> Maybe v
forall a b. (a -> b) -> a -> b
$ PriorityQ k v -> Maybe (v, PriorityQ k v)
forall k v. Ord k => PriorityQ k v -> Maybe (v, PriorityQ k v)
dequeue PriorityQ k v
p