{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.OrdPSQ.Internal
    ( -- * Type
      OrdPSQ (..)
    , LTree (..)
    , Elem (..)

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

      -- * Construction
    , empty
    , singleton

      -- * Insertion
    , insert

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

      -- * Conversion
    , fromList
    , toList
    , toAscList
    , keys

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

      -- * Traversals
    , map
    , unsafeMapMonotonic
    , fold'

      -- * Tournament view
    , TourView (..)
    , tourView
    , play

      -- * Balancing internals
    , left
    , right
    , maxKey
    , lsingleLeft
    , rsingleLeft
    , lsingleRight
    , rsingleRight
    , ldoubleLeft
    , rdoubleLeft
    , ldoubleRight
    , rdoubleRight

      -- * Validity check
    , valid
    ) where

import           Control.DeepSeq  (NFData (rnf))
import           Data.Foldable    (Foldable (foldr))
import qualified Data.List        as List
import           Data.Maybe       (isJust)
import           Data.Traversable
#if MIN_VERSION_base(4,11,0)
import           Prelude          hiding (foldr, lookup, map, null, (<>))
#else
import           Prelude          hiding (foldr, lookup, map, null)
#endif

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

-- | @E k p v@ binds the key @k@ to the value @v@ with priority @p@.
data Elem k p v = E !k !p !v
    deriving (Elem k p a -> Bool
(a -> m) -> Elem k p a -> m
(a -> b -> b) -> b -> Elem k p a -> b
(forall m. Monoid m => Elem k p m -> m)
-> (forall m a. Monoid m => (a -> m) -> Elem k p a -> m)
-> (forall m a. Monoid m => (a -> m) -> Elem k p a -> m)
-> (forall a b. (a -> b -> b) -> b -> Elem k p a -> b)
-> (forall a b. (a -> b -> b) -> b -> Elem k p a -> b)
-> (forall b a. (b -> a -> b) -> b -> Elem k p a -> b)
-> (forall b a. (b -> a -> b) -> b -> Elem k p a -> b)
-> (forall a. (a -> a -> a) -> Elem k p a -> a)
-> (forall a. (a -> a -> a) -> Elem k p a -> a)
-> (forall a. Elem k p a -> [a])
-> (forall a. Elem k p a -> Bool)
-> (forall a. Elem k p a -> Int)
-> (forall a. Eq a => a -> Elem k p a -> Bool)
-> (forall a. Ord a => Elem k p a -> a)
-> (forall a. Ord a => Elem k p a -> a)
-> (forall a. Num a => Elem k p a -> a)
-> (forall a. Num a => Elem k p a -> a)
-> Foldable (Elem k p)
forall a. Eq a => a -> Elem k p a -> Bool
forall a. Num a => Elem k p a -> a
forall a. Ord a => Elem k p a -> a
forall m. Monoid m => Elem k p m -> m
forall a. Elem k p a -> Bool
forall a. Elem k p a -> Int
forall a. Elem k p a -> [a]
forall a. (a -> a -> a) -> Elem k p a -> a
forall m a. Monoid m => (a -> m) -> Elem k p a -> m
forall b a. (b -> a -> b) -> b -> Elem k p a -> b
forall a b. (a -> b -> b) -> b -> Elem k p a -> b
forall k p a. Eq a => a -> Elem k p a -> Bool
forall k p a. Num a => Elem k p a -> a
forall k p a. Ord a => Elem k p a -> a
forall k p m. Monoid m => Elem k p m -> m
forall k p a. Elem k p a -> Bool
forall k p a. Elem k p a -> Int
forall k p a. Elem k p a -> [a]
forall k p a. (a -> a -> a) -> Elem k p a -> a
forall k p m a. Monoid m => (a -> m) -> Elem k p a -> m
forall k p b a. (b -> a -> b) -> b -> Elem k p a -> b
forall k p a b. (a -> b -> b) -> b -> Elem 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 :: Elem k p a -> a
$cproduct :: forall k p a. Num a => Elem k p a -> a
sum :: Elem k p a -> a
$csum :: forall k p a. Num a => Elem k p a -> a
minimum :: Elem k p a -> a
$cminimum :: forall k p a. Ord a => Elem k p a -> a
maximum :: Elem k p a -> a
$cmaximum :: forall k p a. Ord a => Elem k p a -> a
elem :: a -> Elem k p a -> Bool
$celem :: forall k p a. Eq a => a -> Elem k p a -> Bool
length :: Elem k p a -> Int
$clength :: forall k p a. Elem k p a -> Int
null :: Elem k p a -> Bool
$cnull :: forall k p a. Elem k p a -> Bool
toList :: Elem k p a -> [a]
$ctoList :: forall k p a. Elem k p a -> [a]
foldl1 :: (a -> a -> a) -> Elem k p a -> a
$cfoldl1 :: forall k p a. (a -> a -> a) -> Elem k p a -> a
foldr1 :: (a -> a -> a) -> Elem k p a -> a
$cfoldr1 :: forall k p a. (a -> a -> a) -> Elem k p a -> a
foldl' :: (b -> a -> b) -> b -> Elem k p a -> b
$cfoldl' :: forall k p b a. (b -> a -> b) -> b -> Elem k p a -> b
foldl :: (b -> a -> b) -> b -> Elem k p a -> b
$cfoldl :: forall k p b a. (b -> a -> b) -> b -> Elem k p a -> b
foldr' :: (a -> b -> b) -> b -> Elem k p a -> b
$cfoldr' :: forall k p a b. (a -> b -> b) -> b -> Elem k p a -> b
foldr :: (a -> b -> b) -> b -> Elem k p a -> b
$cfoldr :: forall k p a b. (a -> b -> b) -> b -> Elem k p a -> b
foldMap' :: (a -> m) -> Elem k p a -> m
$cfoldMap' :: forall k p m a. Monoid m => (a -> m) -> Elem k p a -> m
foldMap :: (a -> m) -> Elem k p a -> m
$cfoldMap :: forall k p m a. Monoid m => (a -> m) -> Elem k p a -> m
fold :: Elem k p m -> m
$cfold :: forall k p m. Monoid m => Elem k p m -> m
Foldable, a -> Elem k p b -> Elem k p a
(a -> b) -> Elem k p a -> Elem k p b
(forall a b. (a -> b) -> Elem k p a -> Elem k p b)
-> (forall a b. a -> Elem k p b -> Elem k p a)
-> Functor (Elem k p)
forall a b. a -> Elem k p b -> Elem k p a
forall a b. (a -> b) -> Elem k p a -> Elem k p b
forall k p a b. a -> Elem k p b -> Elem k p a
forall k p a b. (a -> b) -> Elem k p a -> Elem k p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Elem k p b -> Elem k p a
$c<$ :: forall k p a b. a -> Elem k p b -> Elem k p a
fmap :: (a -> b) -> Elem k p a -> Elem k p b
$cfmap :: forall k p a b. (a -> b) -> Elem k p a -> Elem k p b
Functor, Int -> Elem k p v -> ShowS
[Elem k p v] -> ShowS
Elem k p v -> String
(Int -> Elem k p v -> ShowS)
-> (Elem k p v -> String)
-> ([Elem k p v] -> ShowS)
-> Show (Elem k p v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k p v.
(Show k, Show p, Show v) =>
Int -> Elem k p v -> ShowS
forall k p v. (Show k, Show p, Show v) => [Elem k p v] -> ShowS
forall k p v. (Show k, Show p, Show v) => Elem k p v -> String
showList :: [Elem k p v] -> ShowS
$cshowList :: forall k p v. (Show k, Show p, Show v) => [Elem k p v] -> ShowS
show :: Elem k p v -> String
$cshow :: forall k p v. (Show k, Show p, Show v) => Elem k p v -> String
showsPrec :: Int -> Elem k p v -> ShowS
$cshowsPrec :: forall k p v.
(Show k, Show p, Show v) =>
Int -> Elem k p v -> ShowS
Show, Functor (Elem k p)
Foldable (Elem k p)
Functor (Elem k p)
-> Foldable (Elem k p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Elem k p a -> f (Elem k p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Elem k p (f a) -> f (Elem k p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Elem k p a -> m (Elem k p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Elem k p (m a) -> m (Elem k p a))
-> Traversable (Elem k p)
(a -> f b) -> Elem k p a -> f (Elem k p b)
forall k p. Functor (Elem k p)
forall k p. Foldable (Elem k p)
forall k p (m :: * -> *) a.
Monad m =>
Elem k p (m a) -> m (Elem k p a)
forall k p (f :: * -> *) a.
Applicative f =>
Elem k p (f a) -> f (Elem k p a)
forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elem k p a -> m (Elem k p b)
forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem k p a -> f (Elem 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 (m :: * -> *) a. Monad m => Elem k p (m a) -> m (Elem k p a)
forall (f :: * -> *) a.
Applicative f =>
Elem k p (f a) -> f (Elem k p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elem k p a -> m (Elem k p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem k p a -> f (Elem k p b)
sequence :: Elem k p (m a) -> m (Elem k p a)
$csequence :: forall k p (m :: * -> *) a.
Monad m =>
Elem k p (m a) -> m (Elem k p a)
mapM :: (a -> m b) -> Elem k p a -> m (Elem k p b)
$cmapM :: forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Elem k p a -> m (Elem k p b)
sequenceA :: Elem k p (f a) -> f (Elem k p a)
$csequenceA :: forall k p (f :: * -> *) a.
Applicative f =>
Elem k p (f a) -> f (Elem k p a)
traverse :: (a -> f b) -> Elem k p a -> f (Elem k p b)
$ctraverse :: forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem k p a -> f (Elem k p b)
$cp2Traversable :: forall k p. Foldable (Elem k p)
$cp1Traversable :: forall k p. Functor (Elem k p)
Traversable)

instance (NFData k, NFData p, NFData v) => NFData (Elem k p v) where
    rnf :: Elem k p v -> ()
rnf (E k
k p
p v
v) = k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` p -> ()
forall a. NFData a => a -> ()
rnf p
p () -> () -> ()
`seq` v -> ()
forall a. NFData a => a -> ()
rnf v
v

-- | A mapping from keys @k@ to priorites @p@ and values @v@. It is strict in
-- keys, priorities and values.
data OrdPSQ k p v
    = Void
    | Winner !(Elem k p v)
             !(LTree k p v)
             !k
    deriving (OrdPSQ k p a -> Bool
(a -> m) -> OrdPSQ k p a -> m
(a -> b -> b) -> b -> OrdPSQ k p a -> b
(forall m. Monoid m => OrdPSQ k p m -> m)
-> (forall m a. Monoid m => (a -> m) -> OrdPSQ k p a -> m)
-> (forall m a. Monoid m => (a -> m) -> OrdPSQ k p a -> m)
-> (forall a b. (a -> b -> b) -> b -> OrdPSQ k p a -> b)
-> (forall a b. (a -> b -> b) -> b -> OrdPSQ k p a -> b)
-> (forall b a. (b -> a -> b) -> b -> OrdPSQ k p a -> b)
-> (forall b a. (b -> a -> b) -> b -> OrdPSQ k p a -> b)
-> (forall a. (a -> a -> a) -> OrdPSQ k p a -> a)
-> (forall a. (a -> a -> a) -> OrdPSQ k p a -> a)
-> (forall a. OrdPSQ k p a -> [a])
-> (forall a. OrdPSQ k p a -> Bool)
-> (forall a. OrdPSQ k p a -> Int)
-> (forall a. Eq a => a -> OrdPSQ k p a -> Bool)
-> (forall a. Ord a => OrdPSQ k p a -> a)
-> (forall a. Ord a => OrdPSQ k p a -> a)
-> (forall a. Num a => OrdPSQ k p a -> a)
-> (forall a. Num a => OrdPSQ k p a -> a)
-> Foldable (OrdPSQ k p)
forall a. Eq a => a -> OrdPSQ k p a -> Bool
forall a. Num a => OrdPSQ k p a -> a
forall a. Ord a => OrdPSQ k p a -> a
forall m. Monoid m => OrdPSQ k p m -> m
forall a. OrdPSQ k p a -> Bool
forall a. OrdPSQ k p a -> Int
forall a. OrdPSQ k p a -> [a]
forall a. (a -> a -> a) -> OrdPSQ k p a -> a
forall m a. Monoid m => (a -> m) -> OrdPSQ k p a -> m
forall b a. (b -> a -> b) -> b -> OrdPSQ k p a -> b
forall a b. (a -> b -> b) -> b -> OrdPSQ k p a -> b
forall k p a. Eq a => a -> OrdPSQ k p a -> Bool
forall k p a. Num a => OrdPSQ k p a -> a
forall k p a. Ord a => OrdPSQ k p a -> a
forall k p m. Monoid m => OrdPSQ k p m -> m
forall k p a. OrdPSQ k p a -> Bool
forall k p a. OrdPSQ k p a -> Int
forall k p a. OrdPSQ k p a -> [a]
forall k p a. (a -> a -> a) -> OrdPSQ k p a -> a
forall k p m a. Monoid m => (a -> m) -> OrdPSQ k p a -> m
forall k p b a. (b -> a -> b) -> b -> OrdPSQ k p a -> b
forall k p a b. (a -> b -> b) -> b -> OrdPSQ 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 :: OrdPSQ k p a -> a
$cproduct :: forall k p a. Num a => OrdPSQ k p a -> a
sum :: OrdPSQ k p a -> a
$csum :: forall k p a. Num a => OrdPSQ k p a -> a
minimum :: OrdPSQ k p a -> a
$cminimum :: forall k p a. Ord a => OrdPSQ k p a -> a
maximum :: OrdPSQ k p a -> a
$cmaximum :: forall k p a. Ord a => OrdPSQ k p a -> a
elem :: a -> OrdPSQ k p a -> Bool
$celem :: forall k p a. Eq a => a -> OrdPSQ k p a -> Bool
length :: OrdPSQ k p a -> Int
$clength :: forall k p a. OrdPSQ k p a -> Int
null :: OrdPSQ k p a -> Bool
$cnull :: forall k p a. OrdPSQ k p a -> Bool
toList :: OrdPSQ k p a -> [a]
$ctoList :: forall k p a. OrdPSQ k p a -> [a]
foldl1 :: (a -> a -> a) -> OrdPSQ k p a -> a
$cfoldl1 :: forall k p a. (a -> a -> a) -> OrdPSQ k p a -> a
foldr1 :: (a -> a -> a) -> OrdPSQ k p a -> a
$cfoldr1 :: forall k p a. (a -> a -> a) -> OrdPSQ k p a -> a
foldl' :: (b -> a -> b) -> b -> OrdPSQ k p a -> b
$cfoldl' :: forall k p b a. (b -> a -> b) -> b -> OrdPSQ k p a -> b
foldl :: (b -> a -> b) -> b -> OrdPSQ k p a -> b
$cfoldl :: forall k p b a. (b -> a -> b) -> b -> OrdPSQ k p a -> b
foldr' :: (a -> b -> b) -> b -> OrdPSQ k p a -> b
$cfoldr' :: forall k p a b. (a -> b -> b) -> b -> OrdPSQ k p a -> b
foldr :: (a -> b -> b) -> b -> OrdPSQ k p a -> b
$cfoldr :: forall k p a b. (a -> b -> b) -> b -> OrdPSQ k p a -> b
foldMap' :: (a -> m) -> OrdPSQ k p a -> m
$cfoldMap' :: forall k p m a. Monoid m => (a -> m) -> OrdPSQ k p a -> m
foldMap :: (a -> m) -> OrdPSQ k p a -> m
$cfoldMap :: forall k p m a. Monoid m => (a -> m) -> OrdPSQ k p a -> m
fold :: OrdPSQ k p m -> m
$cfold :: forall k p m. Monoid m => OrdPSQ k p m -> m
Foldable, a -> OrdPSQ k p b -> OrdPSQ k p a
(a -> b) -> OrdPSQ k p a -> OrdPSQ k p b
(forall a b. (a -> b) -> OrdPSQ k p a -> OrdPSQ k p b)
-> (forall a b. a -> OrdPSQ k p b -> OrdPSQ k p a)
-> Functor (OrdPSQ k p)
forall a b. a -> OrdPSQ k p b -> OrdPSQ k p a
forall a b. (a -> b) -> OrdPSQ k p a -> OrdPSQ k p b
forall k p a b. a -> OrdPSQ k p b -> OrdPSQ k p a
forall k p a b. (a -> b) -> OrdPSQ k p a -> OrdPSQ k p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OrdPSQ k p b -> OrdPSQ k p a
$c<$ :: forall k p a b. a -> OrdPSQ k p b -> OrdPSQ k p a
fmap :: (a -> b) -> OrdPSQ k p a -> OrdPSQ k p b
$cfmap :: forall k p a b. (a -> b) -> OrdPSQ k p a -> OrdPSQ k p b
Functor, Int -> OrdPSQ k p v -> ShowS
[OrdPSQ k p v] -> ShowS
OrdPSQ k p v -> String
(Int -> OrdPSQ k p v -> ShowS)
-> (OrdPSQ k p v -> String)
-> ([OrdPSQ k p v] -> ShowS)
-> Show (OrdPSQ k p v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k p v.
(Show k, Show p, Show v) =>
Int -> OrdPSQ k p v -> ShowS
forall k p v. (Show k, Show p, Show v) => [OrdPSQ k p v] -> ShowS
forall k p v. (Show k, Show p, Show v) => OrdPSQ k p v -> String
showList :: [OrdPSQ k p v] -> ShowS
$cshowList :: forall k p v. (Show k, Show p, Show v) => [OrdPSQ k p v] -> ShowS
show :: OrdPSQ k p v -> String
$cshow :: forall k p v. (Show k, Show p, Show v) => OrdPSQ k p v -> String
showsPrec :: Int -> OrdPSQ k p v -> ShowS
$cshowsPrec :: forall k p v.
(Show k, Show p, Show v) =>
Int -> OrdPSQ k p v -> ShowS
Show, Functor (OrdPSQ k p)
Foldable (OrdPSQ k p)
Functor (OrdPSQ k p)
-> Foldable (OrdPSQ k p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> OrdPSQ k p a -> f (OrdPSQ k p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    OrdPSQ k p (f a) -> f (OrdPSQ k p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> OrdPSQ k p a -> m (OrdPSQ k p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    OrdPSQ k p (m a) -> m (OrdPSQ k p a))
-> Traversable (OrdPSQ k p)
(a -> f b) -> OrdPSQ k p a -> f (OrdPSQ k p b)
forall k p. Functor (OrdPSQ k p)
forall k p. Foldable (OrdPSQ k p)
forall k p (m :: * -> *) a.
Monad m =>
OrdPSQ k p (m a) -> m (OrdPSQ k p a)
forall k p (f :: * -> *) a.
Applicative f =>
OrdPSQ k p (f a) -> f (OrdPSQ k p a)
forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrdPSQ k p a -> m (OrdPSQ k p b)
forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdPSQ k p a -> f (OrdPSQ 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 (m :: * -> *) a.
Monad m =>
OrdPSQ k p (m a) -> m (OrdPSQ k p a)
forall (f :: * -> *) a.
Applicative f =>
OrdPSQ k p (f a) -> f (OrdPSQ k p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrdPSQ k p a -> m (OrdPSQ k p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdPSQ k p a -> f (OrdPSQ k p b)
sequence :: OrdPSQ k p (m a) -> m (OrdPSQ k p a)
$csequence :: forall k p (m :: * -> *) a.
Monad m =>
OrdPSQ k p (m a) -> m (OrdPSQ k p a)
mapM :: (a -> m b) -> OrdPSQ k p a -> m (OrdPSQ k p b)
$cmapM :: forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> OrdPSQ k p a -> m (OrdPSQ k p b)
sequenceA :: OrdPSQ k p (f a) -> f (OrdPSQ k p a)
$csequenceA :: forall k p (f :: * -> *) a.
Applicative f =>
OrdPSQ k p (f a) -> f (OrdPSQ k p a)
traverse :: (a -> f b) -> OrdPSQ k p a -> f (OrdPSQ k p b)
$ctraverse :: forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdPSQ k p a -> f (OrdPSQ k p b)
$cp2Traversable :: forall k p. Foldable (OrdPSQ k p)
$cp1Traversable :: forall k p. Functor (OrdPSQ k p)
Traversable)

instance (NFData k, NFData p, NFData v) => NFData (OrdPSQ k p v) where
    rnf :: OrdPSQ k p v -> ()
rnf OrdPSQ k p v
Void           = ()
    rnf (Winner Elem k p v
e LTree k p v
t k
m) = Elem k p v -> ()
forall a. NFData a => a -> ()
rnf Elem k p v
e () -> () -> ()
`seq` k -> ()
forall a. NFData a => a -> ()
rnf k
m () -> () -> ()
`seq` LTree k p v -> ()
forall a. NFData a => a -> ()
rnf LTree k p v
t

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

type Size = Int

data LTree k p v
    = Start
    | LLoser {-# UNPACK #-} !Size
             {-# UNPACK #-} !(Elem k p v)
                            !(LTree k p v)
                            !k              -- split key
                            !(LTree k p v)
    | RLoser {-# UNPACK #-} !Size
             {-# UNPACK #-} !(Elem k p v)
                            !(LTree k p v)
                            !k              -- split key
                            !(LTree k p v)
    deriving (LTree k p a -> Bool
(a -> m) -> LTree k p a -> m
(a -> b -> b) -> b -> LTree k p a -> b
(forall m. Monoid m => LTree k p m -> m)
-> (forall m a. Monoid m => (a -> m) -> LTree k p a -> m)
-> (forall m a. Monoid m => (a -> m) -> LTree k p a -> m)
-> (forall a b. (a -> b -> b) -> b -> LTree k p a -> b)
-> (forall a b. (a -> b -> b) -> b -> LTree k p a -> b)
-> (forall b a. (b -> a -> b) -> b -> LTree k p a -> b)
-> (forall b a. (b -> a -> b) -> b -> LTree k p a -> b)
-> (forall a. (a -> a -> a) -> LTree k p a -> a)
-> (forall a. (a -> a -> a) -> LTree k p a -> a)
-> (forall a. LTree k p a -> [a])
-> (forall a. LTree k p a -> Bool)
-> (forall a. LTree k p a -> Int)
-> (forall a. Eq a => a -> LTree k p a -> Bool)
-> (forall a. Ord a => LTree k p a -> a)
-> (forall a. Ord a => LTree k p a -> a)
-> (forall a. Num a => LTree k p a -> a)
-> (forall a. Num a => LTree k p a -> a)
-> Foldable (LTree k p)
forall a. Eq a => a -> LTree k p a -> Bool
forall a. Num a => LTree k p a -> a
forall a. Ord a => LTree k p a -> a
forall m. Monoid m => LTree k p m -> m
forall a. LTree k p a -> Bool
forall a. LTree k p a -> Int
forall a. LTree k p a -> [a]
forall a. (a -> a -> a) -> LTree k p a -> a
forall m a. Monoid m => (a -> m) -> LTree k p a -> m
forall b a. (b -> a -> b) -> b -> LTree k p a -> b
forall a b. (a -> b -> b) -> b -> LTree k p a -> b
forall k p a. Eq a => a -> LTree k p a -> Bool
forall k p a. Num a => LTree k p a -> a
forall k p a. Ord a => LTree k p a -> a
forall k p m. Monoid m => LTree k p m -> m
forall k p a. LTree k p a -> Bool
forall k p a. LTree k p a -> Int
forall k p a. LTree k p a -> [a]
forall k p a. (a -> a -> a) -> LTree k p a -> a
forall k p m a. Monoid m => (a -> m) -> LTree k p a -> m
forall k p b a. (b -> a -> b) -> b -> LTree k p a -> b
forall k p a b. (a -> b -> b) -> b -> LTree 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 :: LTree k p a -> a
$cproduct :: forall k p a. Num a => LTree k p a -> a
sum :: LTree k p a -> a
$csum :: forall k p a. Num a => LTree k p a -> a
minimum :: LTree k p a -> a
$cminimum :: forall k p a. Ord a => LTree k p a -> a
maximum :: LTree k p a -> a
$cmaximum :: forall k p a. Ord a => LTree k p a -> a
elem :: a -> LTree k p a -> Bool
$celem :: forall k p a. Eq a => a -> LTree k p a -> Bool
length :: LTree k p a -> Int
$clength :: forall k p a. LTree k p a -> Int
null :: LTree k p a -> Bool
$cnull :: forall k p a. LTree k p a -> Bool
toList :: LTree k p a -> [a]
$ctoList :: forall k p a. LTree k p a -> [a]
foldl1 :: (a -> a -> a) -> LTree k p a -> a
$cfoldl1 :: forall k p a. (a -> a -> a) -> LTree k p a -> a
foldr1 :: (a -> a -> a) -> LTree k p a -> a
$cfoldr1 :: forall k p a. (a -> a -> a) -> LTree k p a -> a
foldl' :: (b -> a -> b) -> b -> LTree k p a -> b
$cfoldl' :: forall k p b a. (b -> a -> b) -> b -> LTree k p a -> b
foldl :: (b -> a -> b) -> b -> LTree k p a -> b
$cfoldl :: forall k p b a. (b -> a -> b) -> b -> LTree k p a -> b
foldr' :: (a -> b -> b) -> b -> LTree k p a -> b
$cfoldr' :: forall k p a b. (a -> b -> b) -> b -> LTree k p a -> b
foldr :: (a -> b -> b) -> b -> LTree k p a -> b
$cfoldr :: forall k p a b. (a -> b -> b) -> b -> LTree k p a -> b
foldMap' :: (a -> m) -> LTree k p a -> m
$cfoldMap' :: forall k p m a. Monoid m => (a -> m) -> LTree k p a -> m
foldMap :: (a -> m) -> LTree k p a -> m
$cfoldMap :: forall k p m a. Monoid m => (a -> m) -> LTree k p a -> m
fold :: LTree k p m -> m
$cfold :: forall k p m. Monoid m => LTree k p m -> m
Foldable, a -> LTree k p b -> LTree k p a
(a -> b) -> LTree k p a -> LTree k p b
(forall a b. (a -> b) -> LTree k p a -> LTree k p b)
-> (forall a b. a -> LTree k p b -> LTree k p a)
-> Functor (LTree k p)
forall a b. a -> LTree k p b -> LTree k p a
forall a b. (a -> b) -> LTree k p a -> LTree k p b
forall k p a b. a -> LTree k p b -> LTree k p a
forall k p a b. (a -> b) -> LTree k p a -> LTree k p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LTree k p b -> LTree k p a
$c<$ :: forall k p a b. a -> LTree k p b -> LTree k p a
fmap :: (a -> b) -> LTree k p a -> LTree k p b
$cfmap :: forall k p a b. (a -> b) -> LTree k p a -> LTree k p b
Functor, Int -> LTree k p v -> ShowS
[LTree k p v] -> ShowS
LTree k p v -> String
(Int -> LTree k p v -> ShowS)
-> (LTree k p v -> String)
-> ([LTree k p v] -> ShowS)
-> Show (LTree k p v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k p v.
(Show k, Show p, Show v) =>
Int -> LTree k p v -> ShowS
forall k p v. (Show k, Show p, Show v) => [LTree k p v] -> ShowS
forall k p v. (Show k, Show p, Show v) => LTree k p v -> String
showList :: [LTree k p v] -> ShowS
$cshowList :: forall k p v. (Show k, Show p, Show v) => [LTree k p v] -> ShowS
show :: LTree k p v -> String
$cshow :: forall k p v. (Show k, Show p, Show v) => LTree k p v -> String
showsPrec :: Int -> LTree k p v -> ShowS
$cshowsPrec :: forall k p v.
(Show k, Show p, Show v) =>
Int -> LTree k p v -> ShowS
Show, Functor (LTree k p)
Foldable (LTree k p)
Functor (LTree k p)
-> Foldable (LTree k p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LTree k p a -> f (LTree k p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LTree k p (f a) -> f (LTree k p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LTree k p a -> m (LTree k p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LTree k p (m a) -> m (LTree k p a))
-> Traversable (LTree k p)
(a -> f b) -> LTree k p a -> f (LTree k p b)
forall k p. Functor (LTree k p)
forall k p. Foldable (LTree k p)
forall k p (m :: * -> *) a.
Monad m =>
LTree k p (m a) -> m (LTree k p a)
forall k p (f :: * -> *) a.
Applicative f =>
LTree k p (f a) -> f (LTree k p a)
forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LTree k p a -> m (LTree k p b)
forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LTree k p a -> f (LTree 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 (m :: * -> *) a.
Monad m =>
LTree k p (m a) -> m (LTree k p a)
forall (f :: * -> *) a.
Applicative f =>
LTree k p (f a) -> f (LTree k p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LTree k p a -> m (LTree k p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LTree k p a -> f (LTree k p b)
sequence :: LTree k p (m a) -> m (LTree k p a)
$csequence :: forall k p (m :: * -> *) a.
Monad m =>
LTree k p (m a) -> m (LTree k p a)
mapM :: (a -> m b) -> LTree k p a -> m (LTree k p b)
$cmapM :: forall k p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LTree k p a -> m (LTree k p b)
sequenceA :: LTree k p (f a) -> f (LTree k p a)
$csequenceA :: forall k p (f :: * -> *) a.
Applicative f =>
LTree k p (f a) -> f (LTree k p a)
traverse :: (a -> f b) -> LTree k p a -> f (LTree k p b)
$ctraverse :: forall k p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LTree k p a -> f (LTree k p b)
$cp2Traversable :: forall k p. Foldable (LTree k p)
$cp1Traversable :: forall k p. Functor (LTree k p)
Traversable)

instance (NFData k, NFData p, NFData v) => NFData (LTree k p v) where
    rnf :: LTree k p v -> ()
rnf LTree k p v
Start              = ()
    rnf (LLoser Int
_ Elem k p v
e LTree k p v
l k
k LTree k p v
r) = Elem k p v -> ()
forall a. NFData a => a -> ()
rnf Elem k p v
e () -> () -> ()
`seq` LTree k p v -> ()
forall a. NFData a => a -> ()
rnf LTree k p v
l () -> () -> ()
`seq` k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` LTree k p v -> ()
forall a. NFData a => a -> ()
rnf LTree k p v
r
    rnf (RLoser Int
_ Elem k p v
e LTree k p v
l k
k LTree k p v
r) = Elem k p v -> ()
forall a. NFData a => a -> ()
rnf Elem k p v
e () -> () -> ()
`seq` LTree k p v -> ()
forall a. NFData a => a -> ()
rnf LTree k p v
l () -> () -> ()
`seq` k -> ()
forall a. NFData a => a -> ()
rnf k
k () -> () -> ()
`seq` LTree k p v -> ()
forall a. NFData a => a -> ()
rnf LTree k p v
r


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

-- | /O(1)/ True if the queue is empty.
null :: OrdPSQ k p v -> Bool
null :: OrdPSQ k p v -> Bool
null OrdPSQ k p v
Void           = Bool
True
null (Winner Elem k p v
_ LTree k p v
_ k
_) = Bool
False

-- | /O(1)/ The number of elements in a queue.
size :: OrdPSQ k p v -> Int
size :: OrdPSQ k p v -> Int
size OrdPSQ k p v
Void            = Int
0
size (Winner Elem k p v
_ LTree k p v
lt k
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
lt

-- | /O(log n)/ Check if a key is present in the the queue.
member :: Ord k => k -> OrdPSQ k p v -> Bool
member :: k -> OrdPSQ k p v -> Bool
member k
k = Maybe (p, v) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (p, v) -> Bool)
-> (OrdPSQ k p v -> Maybe (p, v)) -> OrdPSQ k p v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> OrdPSQ k p v -> Maybe (p, v)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
lookup k
k

-- | /O(log n)/ The priority and value of a given key, or 'Nothing' if the key
-- is not bound.
lookup :: (Ord k) => k -> OrdPSQ k p v -> Maybe (p, v)
lookup :: k -> OrdPSQ k p v -> Maybe (p, v)
lookup k
k = OrdPSQ k p v -> Maybe (p, v)
forall p v. OrdPSQ k p v -> Maybe (p, v)
go
  where
    go :: OrdPSQ k p v -> Maybe (p, v)
go OrdPSQ k p v
t = case OrdPSQ k p v -> TourView k p v
forall k p v. OrdPSQ k p v -> TourView k p v
tourView OrdPSQ k p v
t of
        TourView k p v
Null                 -> Maybe (p, v)
forall a. Maybe a
Nothing
        Single (E k
k' p
p v
v)
            | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'        -> (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p, v
v)
            | Bool
otherwise      -> Maybe (p, v)
forall a. Maybe a
Nothing
        Play OrdPSQ k p v
tl OrdPSQ k p v
tr
            | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= OrdPSQ k p v -> k
forall k p v. OrdPSQ k p v -> k
maxKey OrdPSQ k p v
tl -> OrdPSQ k p v -> Maybe (p, v)
go OrdPSQ k p v
tl
            | Bool
otherwise      -> OrdPSQ k p v -> Maybe (p, v)
go OrdPSQ k p v
tr

-- | /O(1)/ The element with the lowest priority.
findMin :: OrdPSQ k p v -> Maybe (k, p, v)
findMin :: OrdPSQ k p v -> Maybe (k, p, v)
findMin OrdPSQ k p v
Void                   = Maybe (k, p, v)
forall a. Maybe a
Nothing
findMin (Winner (E k
k p
p v
v) LTree k p v
_ k
_) = (k, p, v) -> Maybe (k, p, v)
forall a. a -> Maybe a
Just (k
k, p
p, v
v)


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

-- | /O(1)/ The empty queue.
empty :: OrdPSQ k p v
empty :: OrdPSQ k p v
empty = OrdPSQ k p v
forall k p v. OrdPSQ k p v
Void

-- | /O(1)/ Build a queue with one element.
singleton :: k -> p -> v -> OrdPSQ k p v
singleton :: k -> p -> v -> OrdPSQ k p v
singleton k
k p
p v
v = Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner (k -> p -> v -> Elem k p v
forall k p v. k -> p -> v -> Elem k p v
E k
k p
p v
v) LTree k p v
forall k p v. LTree k p v
Start k
k


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

-- | /O(log n)/ 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, Ord p) => k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert :: k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert k
k p
p v
v = OrdPSQ k p v -> OrdPSQ k p v
go
  where
    go :: OrdPSQ k p v -> OrdPSQ k p v
go OrdPSQ k p v
t = case OrdPSQ k p v
t of
        OrdPSQ k p v
Void -> k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k p
p v
v
        Winner (E k
k' p
p' v
v') LTree k p v
Start k
_ -> case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k' of
            Ordering
LT -> k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k  p
p  v
v  OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k' p
p' v
v'
            Ordering
EQ -> k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k  p
p  v
v
            Ordering
GT -> k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k' p
p' v
v' OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k  p
p  v
v
        Winner Elem k p v
e (RLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m'
            | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m    -> OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m')
            | Bool
otherwise -> (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m')
        Winner Elem k p v
e (LLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m'
            | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m    -> OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m')
            | Bool
otherwise -> (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m')


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

-- | /O(log n)/ 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.
{-# INLINABLE delete #-}
delete :: (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
delete :: k -> OrdPSQ k p v -> OrdPSQ k p v
delete k
k = OrdPSQ k p v -> OrdPSQ k p v
forall p v. Ord p => OrdPSQ k p v -> OrdPSQ k p v
go
  where
    go :: OrdPSQ k p v -> OrdPSQ k p v
go OrdPSQ k p v
t = case OrdPSQ k p v
t of
        OrdPSQ k p v
Void -> OrdPSQ k p v
forall k p v. OrdPSQ k p v
empty
        Winner (E k
k' p
p v
v) LTree k p v
Start k
_
            | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'   -> OrdPSQ k p v
forall k p v. OrdPSQ k p v
empty
            | Bool
otherwise -> k -> p -> v -> OrdPSQ k p v
forall k p v. k -> p -> v -> OrdPSQ k p v
singleton k
k' p
p v
v
        Winner Elem k p v
e (RLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m'
            | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m    -> OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m')
            | Bool
otherwise -> (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m')
        Winner Elem k p v
e (LLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m'
            | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m    -> OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m')
            | Bool
otherwise -> (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v -> OrdPSQ k p v
go (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m')

-- | /O(log n)/ 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
    :: (Ord k, Ord p) => OrdPSQ k p v -> OrdPSQ k p v
deleteMin :: OrdPSQ k p v -> OrdPSQ k p v
deleteMin OrdPSQ k p v
t = case OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
minView OrdPSQ k p v
t of
    Maybe (k, p, v, OrdPSQ k p v)
Nothing            -> OrdPSQ k p v
t
    Just (k
_, p
_, v
_, OrdPSQ k p v
t') -> OrdPSQ k p v
t'

-- | /O(log n)/ 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@.
{-# INLINE alter #-}
alter
    :: (Ord k, Ord p)
    => (Maybe (p, v) -> (b, Maybe (p, v)))
    -> k
    -> OrdPSQ k p v
    -> (b, OrdPSQ k p v)
alter :: (Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
alter Maybe (p, v) -> (b, Maybe (p, v))
f k
k OrdPSQ k p v
psq0 =
    let (OrdPSQ k p v
psq1, Maybe (p, v)
mbPV) = case k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k OrdPSQ k p v
psq0 of
                         Maybe (p, v, OrdPSQ k p v)
Nothing          -> (OrdPSQ k p v
psq0, Maybe (p, v)
forall a. Maybe a
Nothing)
                         Just (p
p, v
v, OrdPSQ k p v
psq) -> (OrdPSQ k p v
psq, (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p, v
v))
        (!b
b, Maybe (p, v)
mbPV') = Maybe (p, v) -> (b, Maybe (p, v))
f Maybe (p, v)
mbPV
    in case Maybe (p, v)
mbPV' of
         Maybe (p, v)
Nothing     -> (b
b, OrdPSQ k p v
psq1)
         Just (p
p, v
v) -> (b
b, k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert k
k p
p v
v OrdPSQ k p v
psq1)

-- | /O(log n)/ 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.
{-# INLINE alterMin #-}
alterMin :: (Ord k, Ord p)
         => (Maybe (k, p, v) -> (b, Maybe (k, p, v)))
         -> OrdPSQ k p v
         -> (b, OrdPSQ k p v)
alterMin :: (Maybe (k, p, v) -> (b, Maybe (k, p, v)))
-> OrdPSQ k p v -> (b, OrdPSQ k p v)
alterMin Maybe (k, p, v) -> (b, Maybe (k, p, v))
f OrdPSQ k p v
psq0 =
    case OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
minView OrdPSQ k p v
psq0 of
        Maybe (k, p, v, OrdPSQ k p v)
Nothing -> let (!b
b, Maybe (k, p, v)
mbKPV) = Maybe (k, p, v) -> (b, Maybe (k, p, v))
f Maybe (k, p, v)
forall a. Maybe a
Nothing
                   in (b
b, Maybe (k, p, v) -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
Maybe (k, p, v) -> OrdPSQ k p v -> OrdPSQ k p v
insertMay Maybe (k, p, v)
mbKPV OrdPSQ k p v
psq0)
        Just (k
k,p
p,v
v, OrdPSQ k p v
psq1) -> let (!b
b, Maybe (k, p, v)
mbKPV) = Maybe (k, p, v) -> (b, Maybe (k, p, v))
f (Maybe (k, p, v) -> (b, Maybe (k, p, v)))
-> Maybe (k, p, v) -> (b, Maybe (k, p, v))
forall a b. (a -> b) -> a -> b
$ (k, p, v) -> Maybe (k, p, v)
forall a. a -> Maybe a
Just (k
k, p
p, v
v)
                              in (b
b, Maybe (k, p, v) -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
Maybe (k, p, v) -> OrdPSQ k p v -> OrdPSQ k p v
insertMay Maybe (k, p, v)
mbKPV OrdPSQ k p v
psq1)
  where
    insertMay :: Maybe (k, p, v) -> OrdPSQ k p v -> OrdPSQ k p v
insertMay Maybe (k, p, v)
Nothing          OrdPSQ k p v
psq = OrdPSQ k p v
psq
    insertMay (Just (k
k, p
p, v
v)) OrdPSQ k p v
psq = k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert k
k p
p v
v OrdPSQ k p v
psq


--------------------------------------------------------------------------------
-- Conversion
--------------------------------------------------------------------------------

-- | /O(n*log n)/ 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 :: (Ord k, Ord p) => [(k, p, v)] -> OrdPSQ k p v
fromList :: [(k, p, v)] -> OrdPSQ k p v
fromList = ((k, p, v) -> OrdPSQ k p v -> OrdPSQ k p v)
-> OrdPSQ k p v -> [(k, p, v)] -> OrdPSQ k p v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(k
k, p
p, v
v) OrdPSQ k p v
q -> k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert k
k p
p v
v OrdPSQ k p v
q) OrdPSQ k p v
forall k p v. OrdPSQ 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.
toList :: OrdPSQ k p v -> [(k, p, v)]
toList :: OrdPSQ k p v -> [(k, p, v)]
toList = OrdPSQ k p v -> [(k, p, v)]
forall k p v. OrdPSQ k p v -> [(k, p, v)]
toAscList

-- | /O(n)/ Obtain the list of present keys in the queue.
keys :: OrdPSQ k p v -> [k]
keys :: OrdPSQ k p v -> [k]
keys OrdPSQ k p v
t = [k
k | (k
k, p
_, v
_) <- OrdPSQ k p v -> [(k, p, v)]
forall k p v. OrdPSQ k p v -> [(k, p, v)]
toList OrdPSQ k p v
t]
-- TODO (jaspervdj): There must be faster implementations.

-- | /O(n)/ Convert to an ascending list.
toAscList :: OrdPSQ k p v -> [(k, p, v)]
toAscList :: OrdPSQ k p v -> [(k, p, v)]
toAscList OrdPSQ k p v
q  = Sequ (k, p, v) -> [(k, p, v)]
forall a. Sequ a -> [a]
seqToList (OrdPSQ k p v -> Sequ (k, p, v)
forall k p v. OrdPSQ k p v -> Sequ (k, p, v)
toAscLists OrdPSQ k p v
q)
  where
    toAscLists :: OrdPSQ k p v -> Sequ (k, p, v)
    toAscLists :: OrdPSQ k p v -> Sequ (k, p, v)
toAscLists OrdPSQ k p v
t = case OrdPSQ k p v -> TourView k p v
forall k p v. OrdPSQ k p v -> TourView k p v
tourView OrdPSQ k p v
t of
        TourView k p v
Null             -> Sequ (k, p, v)
forall a. Sequ a
emptySequ
        Single (E k
k p
p v
v) -> (k, p, v) -> Sequ (k, p, v)
forall a. a -> Sequ a
singleSequ (k
k, p
p, v
v)
        Play OrdPSQ k p v
tl OrdPSQ k p v
tr       -> OrdPSQ k p v -> Sequ (k, p, v)
forall k p v. OrdPSQ k p v -> Sequ (k, p, v)
toAscLists OrdPSQ k p v
tl Sequ (k, p, v) -> Sequ (k, p, v) -> Sequ (k, p, v)
forall a. Sequ a -> Sequ a -> Sequ a
`appendSequ` OrdPSQ k p v -> Sequ (k, p, v)
forall k p v. OrdPSQ k p v -> Sequ (k, p, v)
toAscLists OrdPSQ k p v
tr


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

-- | /O(log n)/ 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
    :: (Ord k, Ord p)
    => k -> p -> v -> OrdPSQ k p v -> (Maybe (p, v), OrdPSQ k p v)
insertView :: k -> p -> v -> OrdPSQ k p v -> (Maybe (p, v), OrdPSQ k p v)
insertView k
k p
p v
x OrdPSQ k p v
t = case k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k OrdPSQ k p v
t of
    Maybe (p, v, OrdPSQ k p v)
Nothing          -> (Maybe (p, v)
forall a. Maybe a
Nothing,       k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert k
k p
p v
x OrdPSQ k p v
t)
    Just (p
p', v
x', OrdPSQ k p v
_) -> ((p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x'), k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
insert k
k p
p v
x OrdPSQ k p v
t)

-- | /O(log n)/ 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 :: (Ord k, Ord p) => k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView :: k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k OrdPSQ k p v
psq = case OrdPSQ k p v
psq of
    OrdPSQ k p v
Void            -> Maybe (p, v, OrdPSQ k p v)
forall a. Maybe a
Nothing
    Winner (E k
k' p
p v
v) LTree k p v
Start k
_
        | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'   -> (p, v, OrdPSQ k p v) -> Maybe (p, v, OrdPSQ k p v)
forall a. a -> Maybe a
Just (p
p, v
v, OrdPSQ k p v
forall k p v. OrdPSQ k p v
empty)
        | Bool
otherwise -> Maybe (p, v, OrdPSQ k p v)
forall a. Maybe a
Nothing
    Winner Elem k p v
e (RLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m'
        | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m    -> ((p, v, OrdPSQ k p v) -> (p, v, OrdPSQ k p v))
-> Maybe (p, v, OrdPSQ k p v) -> Maybe (p, v, OrdPSQ k p v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(p
p,v
v,OrdPSQ k p v
q) -> (p
p, v
v,  OrdPSQ k p v
q OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m'))) (k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m))
        | Bool
otherwise -> ((p, v, OrdPSQ k p v) -> (p, v, OrdPSQ k p v))
-> Maybe (p, v, OrdPSQ k p v) -> Maybe (p, v, OrdPSQ k p v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(p
p,v
v,OrdPSQ k p v
q) -> (p
p, v
v,  (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v
q  )) (k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m'))
    Winner Elem k p v
e (LLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m'
        | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m    -> ((p, v, OrdPSQ k p v) -> (p, v, OrdPSQ k p v))
-> Maybe (p, v, OrdPSQ k p v) -> Maybe (p, v, OrdPSQ k p v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(p
p,v
v,OrdPSQ k p v
q) -> (p
p, v
v, OrdPSQ k p v
q OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m'))) (k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m))
        | Bool
otherwise -> ((p, v, OrdPSQ k p v) -> (p, v, OrdPSQ k p v))
-> Maybe (p, v, OrdPSQ k p v) -> Maybe (p, v, OrdPSQ k p v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(p
p,v
v,OrdPSQ k p v
q) -> (p
p, v
v, (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m) OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v
q )) (k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
forall k p v.
(Ord k, Ord p) =>
k -> OrdPSQ k p v -> Maybe (p, v, OrdPSQ k p v)
deleteView k
k (Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m'))

-- | /O(log n)/ Retrieve the binding with the least priority, and the
-- rest of the queue stripped of that binding.
{-# INLINABLE minView #-}
minView :: (Ord k, Ord p) => OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
minView :: OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
minView OrdPSQ k p v
Void                   = Maybe (k, p, v, OrdPSQ k p v)
forall a. Maybe a
Nothing
minView (Winner (E k
k p
p v
v) LTree k p v
t k
m) = (k, p, v, OrdPSQ k p v) -> Maybe (k, p, v, OrdPSQ k p v)
forall a. a -> Maybe a
Just (k
k, p
p, v
v, LTree k p v -> k -> OrdPSQ k p v
forall k p v. (Ord k, Ord p) => LTree k p v -> k -> OrdPSQ k p v
secondBest LTree k p v
t k
m)

secondBest :: (Ord k, Ord p) => LTree k p v -> k -> OrdPSQ k p v
secondBest :: LTree k p v -> k -> OrdPSQ k p v
secondBest LTree k p v
Start k
_                 = OrdPSQ k p v
forall k p v. OrdPSQ k p v
Void
secondBest (LLoser Int
_ Elem k p v
e LTree k p v
tl k
m LTree k p v
tr) k
m' = Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` LTree k p v -> k -> OrdPSQ k p v
forall k p v. (Ord k, Ord p) => LTree k p v -> k -> OrdPSQ k p v
secondBest LTree k p v
tr k
m'
secondBest (RLoser Int
_ Elem k p v
e LTree k p v
tl k
m LTree k p v
tr) k
m' = LTree k p v -> k -> OrdPSQ k p v
forall k p v. (Ord k, Ord p) => LTree k p v -> k -> OrdPSQ k p v
secondBest LTree k p v
tl k
m OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m'

-- | 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.
atMostView :: (Ord k, Ord p) => p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
atMostView :: p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
atMostView p
pt = [(k, p, v)] -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
forall a c.
Ord a =>
[(a, p, c)] -> OrdPSQ a p c -> ([(a, p, c)], OrdPSQ a p c)
go []
  where
    go :: [(a, p, c)] -> OrdPSQ a p c -> ([(a, p, c)], OrdPSQ a p c)
go [(a, p, c)]
acc t :: OrdPSQ a p c
t@(Winner (E a
_ p
p c
_) LTree a p c
_ a
_)
        | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt                                       = ([(a, p, c)]
acc, OrdPSQ a p c
t)
    go [(a, p, c)]
acc OrdPSQ a p c
Void                                        = ([(a, p, c)]
acc, OrdPSQ a p c
forall k p v. OrdPSQ k p v
Void)
    go [(a, p, c)]
acc (Winner (E a
k p
p c
v) LTree a p c
Start                 a
_)  = ((a
k, p
p, c
v) (a, p, c) -> [(a, p, c)] -> [(a, p, c)]
forall a. a -> [a] -> [a]
: [(a, p, c)]
acc, OrdPSQ a p c
forall k p v. OrdPSQ k p v
Void)
    go [(a, p, c)]
acc (Winner Elem a p c
e         (RLoser Int
_ Elem a p c
e' LTree a p c
tl a
m LTree a p c
tr) a
m') =
        let ([(a, p, c)]
acc',  OrdPSQ a p c
t')  = [(a, p, c)] -> OrdPSQ a p c -> ([(a, p, c)], OrdPSQ a p c)
go [(a, p, c)]
acc  (Elem a p c -> LTree a p c -> a -> OrdPSQ a p c
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem a p c
e  LTree a p c
tl a
m)
            ([(a, p, c)]
acc'', OrdPSQ a p c
t'') = [(a, p, c)] -> OrdPSQ a p c -> ([(a, p, c)], OrdPSQ a p c)
go [(a, p, c)]
acc' (Elem a p c -> LTree a p c -> a -> OrdPSQ a p c
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem a p c
e' LTree a p c
tr a
m') in
        ([(a, p, c)]
acc'', OrdPSQ a p c
t' OrdPSQ a p c -> OrdPSQ a p c -> OrdPSQ a p c
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ a p c
t'')
    go [(a, p, c)]
acc (Winner Elem a p c
e         (LLoser Int
_ Elem a p c
e' LTree a p c
tl a
m LTree a p c
tr) a
m') =
        let ([(a, p, c)]
acc',  OrdPSQ a p c
t')  = [(a, p, c)] -> OrdPSQ a p c -> ([(a, p, c)], OrdPSQ a p c)
go [(a, p, c)]
acc  (Elem a p c -> LTree a p c -> a -> OrdPSQ a p c
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem a p c
e' LTree a p c
tl a
m)
            ([(a, p, c)]
acc'', OrdPSQ a p c
t'') = [(a, p, c)] -> OrdPSQ a p c -> ([(a, p, c)], OrdPSQ a p c)
go [(a, p, c)]
acc' (Elem a p c -> LTree a p c -> a -> OrdPSQ a p c
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem a p c
e  LTree a p c
tr a
m') in
        ([(a, p, c)]
acc'', OrdPSQ a p c
t' OrdPSQ a p c -> OrdPSQ a p c -> OrdPSQ a p c
forall p k v.
(Ord p, Ord k) =>
OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ a p c
t'')


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

-- | /O(n)/ Modify every value in the queue.
{-# INLINABLE map #-}
map :: forall k p v w. (k -> p -> v -> w) -> OrdPSQ k p v -> OrdPSQ k p w
map :: (k -> p -> v -> w) -> OrdPSQ k p v -> OrdPSQ k p w
map k -> p -> v -> w
f =
    OrdPSQ k p v -> OrdPSQ k p w
goPSQ
  where
    goPSQ :: OrdPSQ k p v -> OrdPSQ k p w
    goPSQ :: OrdPSQ k p v -> OrdPSQ k p w
goPSQ OrdPSQ k p v
Void           = OrdPSQ k p w
forall k p v. OrdPSQ k p v
Void
    goPSQ (Winner Elem k p v
e LTree k p v
l k
k) = Elem k p w -> LTree k p w -> k -> OrdPSQ k p w
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner (Elem k p v -> Elem k p w
goElem Elem k p v
e) (LTree k p v -> LTree k p w
goLTree LTree k p v
l) k
k

    goElem :: Elem k p v -> Elem k p w
    goElem :: Elem k p v -> Elem k p w
goElem (E k
k p
p v
x) = k -> p -> w -> Elem k p w
forall k p v. k -> p -> v -> Elem k p v
E k
k p
p (k -> p -> v -> w
f k
k p
p v
x)

    goLTree :: LTree k p v -> LTree k p w
    goLTree :: LTree k p v -> LTree k p w
goLTree LTree k p v
Start              = LTree k p w
forall k p v. LTree k p v
Start
    goLTree (LLoser Int
s Elem k p v
e LTree k p v
l k
k LTree k p v
r) = Int -> Elem k p w -> LTree k p w -> k -> LTree k p w -> LTree k p w
forall k p v.
Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
LLoser Int
s (Elem k p v -> Elem k p w
goElem Elem k p v
e) (LTree k p v -> LTree k p w
goLTree LTree k p v
l) k
k (LTree k p v -> LTree k p w
goLTree LTree k p v
r)
    goLTree (RLoser Int
s Elem k p v
e LTree k p v
l k
k LTree k p v
r) = Int -> Elem k p w -> LTree k p w -> k -> LTree k p w -> LTree k p w
forall k p v.
Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
RLoser Int
s (Elem k p v -> Elem k p w
goElem Elem k p v
e) (LTree k p v -> LTree k p w
goLTree LTree k p v
l) k
k (LTree k p v -> LTree k p w
goLTree LTree k p v
r)

-- | /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
    :: forall k p q v w.
       (k -> p -> v -> (q, w))
    -> OrdPSQ k p v
    -> OrdPSQ k q w
unsafeMapMonotonic :: (k -> p -> v -> (q, w)) -> OrdPSQ k p v -> OrdPSQ k q w
unsafeMapMonotonic k -> p -> v -> (q, w)
f = OrdPSQ k p v -> OrdPSQ k q w
goPSQ
  where
    goPSQ :: OrdPSQ k p v -> OrdPSQ k q w
    goPSQ :: OrdPSQ k p v -> OrdPSQ k q w
goPSQ OrdPSQ k p v
Void           = OrdPSQ k q w
forall k p v. OrdPSQ k p v
Void
    goPSQ (Winner Elem k p v
e LTree k p v
l k
k) = Elem k q w -> LTree k q w -> k -> OrdPSQ k q w
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner (Elem k p v -> Elem k q w
goElem Elem k p v
e) (LTree k p v -> LTree k q w
goLTree LTree k p v
l) k
k

    goElem :: Elem k p v -> Elem k q w
    goElem :: Elem k p v -> Elem k q w
goElem (E k
k p
p v
x) = let (q
p', w
x') = k -> p -> v -> (q, w)
f k
k p
p v
x
                       in k -> q -> w -> Elem k q w
forall k p v. k -> p -> v -> Elem k p v
E k
k q
p' w
x'

    goLTree :: LTree k p v -> LTree k q w
    goLTree :: LTree k p v -> LTree k q w
goLTree LTree k p v
Start              = LTree k q w
forall k p v. LTree k p v
Start
    goLTree (LLoser Int
s Elem k p v
e LTree k p v
l k
k LTree k p v
r) = Int -> Elem k q w -> LTree k q w -> k -> LTree k q w -> LTree k q w
forall k p v.
Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
LLoser Int
s (Elem k p v -> Elem k q w
goElem Elem k p v
e) (LTree k p v -> LTree k q w
goLTree LTree k p v
l) k
k (LTree k p v -> LTree k q w
goLTree LTree k p v
r)
    goLTree (RLoser Int
s Elem k p v
e LTree k p v
l k
k LTree k p v
r) = Int -> Elem k q w -> LTree k q w -> k -> LTree k q w -> LTree k q w
forall k p v.
Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
RLoser Int
s (Elem k p v -> Elem k q w
goElem Elem k p v
e) (LTree k p v -> LTree k q w
goLTree LTree k p v
l) k
k (LTree k p v -> LTree k q w
goLTree LTree k p v
r)

-- | /O(n)/ Strict fold over every key, priority and value in the queue. The order
-- in which the fold is performed is not specified.
{-# INLINE fold' #-}
fold' :: (k -> p -> v -> a -> a) -> a -> OrdPSQ k p v -> a
fold' :: (k -> p -> v -> a -> a) -> a -> OrdPSQ k p v -> a
fold' k -> p -> v -> a -> a
f =
    \a
acc0 OrdPSQ k p v
psq -> case OrdPSQ k p v
psq of
                   OrdPSQ k p v
Void                   -> a
acc0
                   (Winner (E k
k p
p v
v) LTree k p v
t k
_) ->
                        let !acc1 :: a
acc1 = k -> p -> v -> a -> a
f k
k p
p v
v a
acc0
                        in  a -> LTree k p v -> a
go a
acc1 LTree k p v
t
  where
    go :: a -> LTree k p v -> a
go !a
acc LTree k p v
Start                        = a
acc
    go !a
acc (LLoser Int
_ (E k
k p
p v
v) LTree k p v
lt k
_ LTree k p v
rt) = a -> LTree k p v -> a
go (k -> p -> v -> a -> a
f k
k p
p v
v (a -> LTree k p v -> a
go a
acc LTree k p v
lt)) LTree k p v
rt
    go !a
acc (RLoser Int
_ (E k
k p
p v
v) LTree k p v
lt k
_ LTree k p v
rt) = a -> LTree k p v -> a
go (k -> p -> v -> a -> a
f k
k p
p v
v (a -> LTree k p v -> a
go a
acc LTree k p v
lt)) LTree k p v
rt


--------------------------------------------------------------------------------
-- Tournament view
--------------------------------------------------------------------------------

data TourView k p v
    = Null
    | Single {-# UNPACK #-} !(Elem k p v)
    | Play (OrdPSQ k p v) (OrdPSQ k p v)

tourView :: OrdPSQ k p v -> TourView k p v
tourView :: OrdPSQ k p v -> TourView k p v
tourView OrdPSQ k p v
Void               = TourView k p v
forall k p v. TourView k p v
Null
tourView (Winner Elem k p v
e LTree k p v
Start k
_) = Elem k p v -> TourView k p v
forall k p v. Elem k p v -> TourView k p v
Single Elem k p v
e
tourView (Winner Elem k p v
e (RLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m') =
    Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tl k
m OrdPSQ k p v -> OrdPSQ k p v -> TourView k p v
forall k p v. OrdPSQ k p v -> OrdPSQ k p v -> TourView k p v
`Play` Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tr k
m'
tourView (Winner Elem k p v
e (LLoser Int
_ Elem k p v
e' LTree k p v
tl k
m LTree k p v
tr) k
m') =
    Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' LTree k p v
tl k
m OrdPSQ k p v -> OrdPSQ k p v -> TourView k p v
forall k p v. OrdPSQ k p v -> OrdPSQ k p v -> TourView k p v
`Play` Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e LTree k p v
tr k
m'

-- | Take two pennants and returns a new pennant that is the union of
-- the two with the precondition that the keys in the first tree are
-- strictly smaller than the keys in the second tree.
{-# INLINABLE play #-}
play :: (Ord p, Ord k) => OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ k p v
Void play :: OrdPSQ k p v -> OrdPSQ k p v -> OrdPSQ k p v
`play` OrdPSQ k p v
t' = OrdPSQ k p v
t'
OrdPSQ k p v
t `play` OrdPSQ k p v
Void  = OrdPSQ k p v
t
Winner e :: Elem k p v
e@(E k
k p
p v
v) LTree k p v
t k
m `play` Winner e' :: Elem k p v
e'@(E k
k' p
p' v
v') LTree k p v
t' k
m'
    | (p
p, k
k) (p, k) -> (p, k) -> Bool
forall p k. (Ord p, Ord k) => (p, k) -> (p, k) -> Bool
`beats` (p
p', k
k') = Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalance k
k' p
p' v
v' LTree k p v
t k
m LTree k p v
t') k
m'
    | Bool
otherwise               = Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
forall k p v. Elem k p v -> LTree k p v -> k -> OrdPSQ k p v
Winner Elem k p v
e' (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalance k
k p
p v
v LTree k p v
t k
m LTree k p v
t') k
m'

-- | When priorities are equal, the tree with the lowest key wins. This is
-- important to have a deterministic `==`, which requires on `minView` pulling
-- out the elements in the right order.
beats :: (Ord p, Ord k) => (p, k) -> (p, k) -> Bool
beats :: (p, k) -> (p, k) -> Bool
beats (p
p, !k
k) (p
p', !k
k') = p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
p' Bool -> Bool -> Bool
|| (p
p p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
p' Bool -> Bool -> Bool
&& k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k')
{-# INLINE beats #-}


--------------------------------------------------------------------------------
-- Balancing internals
--------------------------------------------------------------------------------

-- | Balance factor
omega :: Int
omega :: Int
omega = Int
4  -- Has to be greater than 3.75 because Hinze's paper said so.

size' :: LTree k p v -> Size
size' :: LTree k p v -> Int
size' LTree k p v
Start              = Int
0
size' (LLoser Int
s Elem k p v
_ LTree k p v
_ k
_ LTree k p v
_) = Int
s
size' (RLoser Int
s Elem k p v
_ LTree k p v
_ k
_ LTree k p v
_) = Int
s

left, right :: LTree k p v -> LTree k p v

left :: LTree k p v -> LTree k p v
left LTree k p v
Start                = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"left" String
"empty loser tree"
left (LLoser Int
_ Elem k p v
_ LTree k p v
tl k
_ LTree k p v
_ ) = LTree k p v
tl
left (RLoser Int
_ Elem k p v
_ LTree k p v
tl k
_ LTree k p v
_ ) = LTree k p v
tl

right :: LTree k p v -> LTree k p v
right LTree k p v
Start                = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"right" String
"empty loser tree"
right (LLoser Int
_ Elem k p v
_ LTree k p v
_  k
_ LTree k p v
tr) = LTree k p v
tr
right (RLoser Int
_ Elem k p v
_ LTree k p v
_  k
_ LTree k p v
tr) = LTree k p v
tr

maxKey :: OrdPSQ k p v -> k
maxKey :: OrdPSQ k p v -> k
maxKey OrdPSQ k p v
Void           = String -> String -> k
forall a. String -> String -> a
moduleError String
"maxKey" String
"empty queue"
maxKey (Winner Elem k p v
_ LTree k p v
_ k
m) = k
m

lloser, rloser :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k p
p v
v LTree k p v
tl k
m LTree k p v
tr = Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
LLoser (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
tl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
tr) (k -> p -> v -> Elem k p v
forall k p v. k -> p -> v -> Elem k p v
E k
k p
p v
v) LTree k p v
tl k
m LTree k p v
tr
rloser :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k p
p v
v LTree k p v
tl k
m LTree k p v
tr = Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
Int -> Elem k p v -> LTree k p v -> k -> LTree k p v -> LTree k p v
RLoser (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
tl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
tr) (k -> p -> v -> Elem k p v
forall k p v. k -> p -> v -> Elem k p v
E k
k p
p v
v) LTree k p v
tl k
m LTree k p v
tr

lbalance, rbalance
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalance :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalance k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2     = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser        k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
l = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalanceLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
r = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalanceRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | Bool
otherwise                 = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser        k
k p
p v
v LTree k p v
l k
m LTree k p v
r

rbalance :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalance k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2     = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser        k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
l = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalanceLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' LTree k p v
r = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalanceRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | Bool
otherwise                 = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser        k
k p
p v
v LTree k p v
l k
m LTree k p v
r

lbalanceLeft
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalanceLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalanceLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
left LTree k p v
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
right LTree k p v
r) = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | Bool
otherwise                        = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
ldoubleLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r

lbalanceRight
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalanceRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lbalanceRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
left LTree k p v
l) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
right LTree k p v
l) = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | Bool
otherwise                        = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
ldoubleRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r

rbalanceLeft
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalanceLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalanceLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
left LTree k p v
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
right LTree k p v
r) = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | Bool
otherwise                        = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rdoubleLeft  k
k p
p v
v LTree k p v
l k
m LTree k p v
r

rbalanceRight
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalanceRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rbalanceRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
left LTree k p v
l) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LTree k p v -> Int
forall k p a. LTree k p a -> Int
size' (LTree k p v -> LTree k p v
forall k p v. LTree k p v -> LTree k p v
right LTree k p v
l) = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r
    | Bool
otherwise                        = k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rdoubleRight k
k p
p v
v LTree k p v
l k
m LTree k p v
r

lsingleLeft
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3)
    | (p
p1, k
k1) (p, k) -> (p, k) -> Bool
forall p k. (Ord p, Ord k) => (p, k) -> (p, k) -> Bool
`beats` (p
p2, k
k2) =
        k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k1 p
p1 v
v1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
    | Bool
otherwise                 =
        k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k2 p
p2 v
v2 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
lsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k2 p
p2 v
v2 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
lsingleLeft k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"lsingleLeft" String
"malformed tree"

rsingleLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k1 p
p1 v
v1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
rsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k2 p
p2 v
v2 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
rsingleLeft k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"rsingleLeft" String
"malformed tree"

lsingleRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight k
k1 p
p1 v
v1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k1 p
p1 v
v1 LTree k p v
t2 k
m2 LTree k p v
t3)
lsingleRight k
k1 p
p1 v
v1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k2 p
p2 v
v2 LTree k p v
t2 k
m2 LTree k p v
t3)
lsingleRight k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"lsingleRight" String
"malformed tree"

rsingleRight
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight k
k1 p
p1 v
v1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k1 p
p1 v
v1 LTree k p v
t2 k
m2 LTree k p v
t3)
rsingleRight k
k1 p
p1 v
v1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
    | (p
p1, k
k1) (p, k) -> (p, k) -> Bool
forall p k. (Ord p, Ord k) => (p, k) -> (p, k) -> Bool
`beats` (p
p2, k
k2) =
        k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lloser k
k2 p
p2 v
v2 LTree k p v
t2 k
m2 LTree k p v
t3)
    | Bool
otherwise                 =
        k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rloser k
k1 p
p1 v
v1 LTree k p v
t2 k
m2 LTree k p v
t3)
rsingleRight k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"rsingleRight" String
"malformed tree"

ldoubleLeft
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
ldoubleLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
ldoubleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight k
k2 p
p2 v
v2 LTree k p v
t2 k
m2 LTree k p v
t3)
ldoubleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight k
k2 p
p2 v
v2 LTree k p v
t2 k
m2 LTree k p v
t3)
ldoubleLeft k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"ldoubleLeft" String
"malformed tree"

ldoubleRight
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
ldoubleRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
ldoubleRight k
k1 p
p1 v
v1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight k
k1 p
p1 v
v1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
ldoubleRight k
k1 p
p1 v
v1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight k
k1 p
p1 v
v1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
ldoubleRight k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"ldoubleRight" String
"malformed tree"

rdoubleLeft
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rdoubleLeft :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rdoubleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleRight k
k2 p
p2 v
v2 LTree k p v
t2 k
m2 LTree k p v
t3)
rdoubleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t2 k
m2 LTree k p v
t3) =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft k
k1 p
p1 v
v1 LTree k p v
t1 k
m1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight k
k2 p
p2 v
v2 LTree k p v
t2 k
m2 LTree k p v
t3)
rdoubleLeft k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"rdoubleLeft" String
"malformed tree"

rdoubleRight
    :: (Ord k, Ord p)
    => k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rdoubleRight :: k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rdoubleRight k
k1 p
p1 v
v1 (LLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight k
k1 p
p1 v
v1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
lsingleLeft k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
rdoubleRight k
k1 p
p1 v
v1 (RLoser Int
_ (E k
k2 p
p2 v
v2) LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3 =
    k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleRight k
k1 p
p1 v
v1 (k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
forall k p v.
k -> p -> v -> LTree k p v -> k -> LTree k p v -> LTree k p v
rsingleLeft k
k2 p
p2 v
v2 LTree k p v
t1 k
m1 LTree k p v
t2) k
m2 LTree k p v
t3
rdoubleRight k
_ p
_ v
_ LTree k p v
_ k
_ LTree k p v
_ = String -> String -> LTree k p v
forall a. String -> String -> a
moduleError String
"rdoubleRight" String
"malformed tree"


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

-- | /O(n^2)/ Internal function to check if the 'OrdPSQ' is valid, i.e. if all
-- invariants hold. This should always be the case.
valid :: (Ord k, Ord p) => OrdPSQ k p v -> Bool
valid :: OrdPSQ k p v -> Bool
valid OrdPSQ k p v
t =
    Bool -> Bool
not (OrdPSQ k p v -> Bool
forall k p v. Ord k => OrdPSQ k p v -> Bool
hasDuplicateKeys OrdPSQ k p v
t)      Bool -> Bool -> Bool
&&
    OrdPSQ k p v -> Bool
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
hasMinHeapProperty OrdPSQ k p v
t          Bool -> Bool -> Bool
&&
    OrdPSQ k p v -> Bool
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
hasBinarySearchTreeProperty OrdPSQ k p v
t Bool -> Bool -> Bool
&&
    OrdPSQ k p v -> Bool
forall k p a. OrdPSQ k p a -> Bool
hasCorrectSizeAnnotations OrdPSQ k p v
t

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

hasMinHeapProperty :: forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
hasMinHeapProperty :: OrdPSQ k p v -> Bool
hasMinHeapProperty OrdPSQ k p v
Void                      = Bool
True
hasMinHeapProperty (Winner (E k
k0 p
p0 v
_) LTree k p v
t0 k
_) = k -> p -> LTree k p v -> Bool
go k
k0 p
p0 LTree k p v
t0
  where
    go :: k -> p -> LTree k p v -> Bool
    go :: k -> p -> LTree k p v -> Bool
go k
_ p
_ LTree k p v
Start                        = Bool
True
    go k
k p
p (LLoser Int
_ (E k
k' p
p' v
_) LTree k p v
l k
_ LTree k p v
r) =
        (p
p, k
k) (p, k) -> (p, k) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', k
k') Bool -> Bool -> Bool
&& k -> p -> LTree k p v -> Bool
go k
k' p
p' LTree k p v
l Bool -> Bool -> Bool
&& k -> p -> LTree k p v -> Bool
go k
k  p
p  LTree k p v
r
    go k
k p
p (RLoser Int
_ (E k
k' p
p' v
_) LTree k p v
l k
_ LTree k p v
r) =
        (p
p, k
k) (p, k) -> (p, k) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', k
k') Bool -> Bool -> Bool
&& k -> p -> LTree k p v -> Bool
go k
k  p
p  LTree k p v
l Bool -> Bool -> Bool
&& k -> p -> LTree k p v -> Bool
go k
k' p
p' LTree k p v
r

hasBinarySearchTreeProperty
    :: forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
hasBinarySearchTreeProperty :: OrdPSQ k p v -> Bool
hasBinarySearchTreeProperty OrdPSQ k p v
t = case OrdPSQ k p v -> TourView k p v
forall k p v. OrdPSQ k p v -> TourView k p v
tourView OrdPSQ k p v
t of
    TourView k p v
Null      -> Bool
True
    Single Elem k p v
_  -> Bool
True
    Play OrdPSQ k p v
l OrdPSQ k p v
r  ->
        (k -> Bool) -> [k] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
k) (OrdPSQ k p v -> [k]
forall k p v. OrdPSQ k p v -> [k]
keys OrdPSQ k p v
l)           Bool -> Bool -> Bool
&&
        (k -> Bool) -> [k] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
k) (OrdPSQ k p v -> [k]
forall k p v. OrdPSQ k p v -> [k]
keys OrdPSQ k p v
r)           Bool -> Bool -> Bool
&&
        OrdPSQ k p v -> Bool
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
hasBinarySearchTreeProperty OrdPSQ k p v
l Bool -> Bool -> Bool
&&
        OrdPSQ k p v -> Bool
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> Bool
hasBinarySearchTreeProperty OrdPSQ k p v
r
      where
        k :: k
k = OrdPSQ k p v -> k
forall k p v. OrdPSQ k p v -> k
maxKey OrdPSQ k p v
l

hasCorrectSizeAnnotations :: OrdPSQ k p v -> Bool
hasCorrectSizeAnnotations :: OrdPSQ k p v -> Bool
hasCorrectSizeAnnotations OrdPSQ k p v
Void            = Bool
True
hasCorrectSizeAnnotations (Winner Elem k p v
_ LTree k p v
t0 k
_) = LTree k p v -> Bool
forall k p a. LTree k p a -> Bool
go LTree k p v
t0
  where
    go :: LTree k p v -> Bool
    go :: LTree k p v -> Bool
go t :: LTree k p v
t@LTree k p v
Start              = LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    go t :: LTree k p v
t@(LLoser Int
s Elem k p v
_ LTree k p v
l k
_ LTree k p v
r) = LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s Bool -> Bool -> Bool
&& LTree k p v -> Bool
forall k p a. LTree k p a -> Bool
go LTree k p v
l Bool -> Bool -> Bool
&& LTree k p v -> Bool
forall k p a. LTree k p a -> Bool
go LTree k p v
r
    go t :: LTree k p v
t@(RLoser Int
s Elem k p v
_ LTree k p v
l k
_ LTree k p v
r) = LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s Bool -> Bool -> Bool
&& LTree k p v -> Bool
forall k p a. LTree k p a -> Bool
go LTree k p v
l Bool -> Bool -> Bool
&& LTree k p v -> Bool
forall k p a. LTree k p a -> Bool
go LTree k p v
r

    calculateSize :: LTree k p v -> Int
    calculateSize :: LTree k p v -> Int
calculateSize LTree k p v
Start              = Int
0
    calculateSize (LLoser Int
_ Elem k p v
_ LTree k p v
l k
_ LTree k p v
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
r
    calculateSize (RLoser Int
_ Elem k p v
_ LTree k p v
l k
_ LTree k p v
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p v -> Int
forall k p a. LTree k p a -> Int
calculateSize LTree k p v
r


--------------------------------------------------------------------------------
-- Utility functions
--------------------------------------------------------------------------------

moduleError :: String -> String -> a
moduleError :: String -> String -> a
moduleError String
fun String
msg = String -> a
forall a. HasCallStack => String -> a
error (String
"Data.OrdPSQ.Internal." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
msg)
{-# NOINLINE moduleError #-}

-- | Hughes's efficient sequence type
newtype Sequ a = Sequ ([a] -> [a])

emptySequ :: Sequ a
emptySequ :: Sequ a
emptySequ = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as -> [a]
as)

singleSequ :: a -> Sequ a
singleSequ :: a -> Sequ a
singleSequ a
a = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)

appendSequ :: Sequ a -> Sequ a -> Sequ a
appendSequ :: Sequ a -> Sequ a -> Sequ a
appendSequ (Sequ [a] -> [a]
x1) (Sequ [a] -> [a]
x2) = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as -> [a] -> [a]
x1 ([a] -> [a]
x2 [a]
as))

seqToList :: Sequ a -> [a]
seqToList :: Sequ a -> [a]
seqToList (Sequ [a] -> [a]
x) = [a] -> [a]
x []