{-# LANGUAGE FlexibleContexts, LambdaCase, MultiParamTypeClasses        #-}
{-# LANGUAGE NoMonomorphismRestriction, PatternSynonyms, RankNTypes     #-}
{-# LANGUAGE RoleAnnotations, ScopedTypeVariables, UndecidableInstances #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Data.Heap.Pairing
  ( Pairing,
    -- * Basic Operations
    empty, null, singleton, fromList, insert,
    merge, union, mapMonotonic,
    -- * Query
    findMin, deleteMin, viewMin, uncons, span
  ) where
import           Data.Coerce     (coerce)
import qualified Data.Foldable   as F
import qualified Data.Heap.Class as HC
import           Data.List       (unfoldr)
import           Data.Maybe      (fromJust)
import           Data.Proxy      (Proxy (..))
import           Data.Reflection (Reifies (..), reify)
import           Data.Semigroup  (Semigroup (..))
import           Prelude         hiding (null, span)

-- | Ephemeral heap, implemented as a Pairing Pairing.
data Pairing a = Empty
            | Pairing (a -> a -> Ordering) (Rose a)
type role Pairing nominal

reifyOrd :: (a -> a -> Ordering) -> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd :: (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c = ReifiedOrd a
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify (ReifiedOrd a
 -> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r)
-> ReifiedOrd a
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r)
-> r
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> ReifiedOrd a
forall a. (a -> a -> Ordering) -> ReifiedOrd a
ReifiedOrd a -> a -> Ordering
c
{-# INLINE reifyOrd #-}

newtype ReflectedOrd a s = ReflectedOrd a
newtype ReifiedOrd a = ReifiedOrd { ReifiedOrd a -> a -> a -> Ordering
reifiedCompare :: a -> a -> Ordering }

instance Reifies s (ReifiedOrd a) => Eq (ReflectedOrd a s) where
  a :: ReflectedOrd a s
a@(ReflectedOrd a
x) == :: ReflectedOrd a s -> ReflectedOrd a s -> Bool
== ReflectedOrd a
y =
    case ReifiedOrd a -> a -> a -> Ordering
forall a. ReifiedOrd a -> a -> a -> Ordering
reifiedCompare (ReflectedOrd a s -> ReifiedOrd a
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect ReflectedOrd a s
a) a
x a
y of
      Ordering
EQ -> Bool
True
      Ordering
_  -> Bool
False
  {-# INLINE (==) #-}

instance (Reifies s (ReifiedOrd a)) => Ord (ReflectedOrd a s) where
  compare :: ReflectedOrd a s -> ReflectedOrd a s -> Ordering
compare a :: ReflectedOrd a s
a@(ReflectedOrd a
x) (ReflectedOrd a
y) =
    ReifiedOrd a -> a -> a -> Ordering
forall a. ReifiedOrd a -> a -> a -> Ordering
reifiedCompare (ReflectedOrd a s -> ReifiedOrd a
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect ReflectedOrd a s
a) a
x a
y
  {-# INLINE compare #-}

-- | Folds item in an increasing order
instance Foldable Pairing where
  minimum :: Pairing a -> a
minimum = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Pairing a -> Maybe a) -> Pairing a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pairing a -> Maybe a
forall a. Pairing a -> Maybe a
findMin
  {-# INLINE minimum #-}
  foldMap :: (a -> m) -> Pairing a -> m
foldMap a -> m
_ Pairing a
Empty = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (Pairing a -> a -> Ordering
c Rose a
t) =
    (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> m) -> m
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c ((forall s. Reifies s (ReifiedOrd a) => Proxy s -> m) -> m)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> m) -> m
forall a b. (a -> b) -> a -> b
$ \Proxy s
m ->
    (ReflectedOrd a s -> m) -> Rose (ReflectedOrd a s) -> m
forall m a. (Monoid m, Ord a) => (a -> m) -> Rose a -> m
rfoldMap ((a -> m) -> ReflectedOrd a s -> m
coerce a -> m
f) (Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
m Rose a
t)
  {-# INLINE foldMap #-}

rfoldMap :: (Monoid m, Ord a) => (a -> m) -> Rose a -> m
rfoldMap :: (a -> m) -> Rose a -> m
rfoldMap a -> m
f (T' a
x []) = a -> m
f a
x
rfoldMap a -> m
f (T' a
x [Rose a]
rs) =
  a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Rose a -> m
forall m a. (Monoid m, Ord a) => (a -> m) -> Rose a -> m
rfoldMap a -> m
f ([Rose a] -> Rose a
forall a. Ord a => [Rose a] -> Rose a
merges [Rose a]
rs)

castRose :: Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose :: Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
_ = Rose a -> Rose (ReflectedOrd a s)
coerce
{-# INLINE castRose #-}

castRoses :: Proxy s -> [Rose a] -> [Rose (ReflectedOrd a s)]
castRoses :: Proxy s -> [Rose a] -> [Rose (ReflectedOrd a s)]
castRoses  Proxy s
_ = [Rose a] -> [Rose (ReflectedOrd a s)]
coerce
{-# INLINE castRoses #-}

instance Eq (Pairing a) where
  Pairing a
Empty    == :: Pairing a -> Pairing a -> Bool
== Pairing a
Empty    = Bool
True
  Pairing a
Empty    == Pairing a
_        = Bool
False
  Pairing a
_        == Pairing a
Empty    = Bool
False
  Pairing a -> a -> Ordering
c Rose a
t == Pairing a -> a -> Ordering
_ Rose a
u =
    (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Bool) -> Bool
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c ((forall s. Reifies s (ReifiedOrd a) => Proxy s -> Bool) -> Bool)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Proxy s
pxy ->
    Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
pxy Rose a
t Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s) -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
pxy Rose a
u
  {-# INLINE (==) #-}

instance Ord (Pairing a) where
  Pairing a
Empty    compare :: Pairing a -> Pairing a -> Ordering
`compare` Pairing a
Empty    = Ordering
EQ
  Pairing a
Empty    `compare` Pairing a
_        = Ordering
LT
  Pairing a
_        `compare` Pairing a
Empty    = Ordering
GT
  Pairing a -> a -> Ordering
c Rose a
t `compare` Pairing a -> a -> Ordering
_ Rose a
u =
    (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Ordering)
-> Ordering
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c ((forall s. Reifies s (ReifiedOrd a) => Proxy s -> Ordering)
 -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Ordering)
-> Ordering
forall a b. (a -> b) -> a -> b
$ \Proxy s
pxy ->
    Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
pxy Rose a
t) (Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
pxy Rose a
u)
  {-# INLINE compare #-}

data Rose a = T' !a ![Rose a]
  deriving (ReadPrec [Rose a]
ReadPrec (Rose a)
Int -> ReadS (Rose a)
ReadS [Rose a]
(Int -> ReadS (Rose a))
-> ReadS [Rose a]
-> ReadPrec (Rose a)
-> ReadPrec [Rose a]
-> Read (Rose a)
forall a. Read a => ReadPrec [Rose a]
forall a. Read a => ReadPrec (Rose a)
forall a. Read a => Int -> ReadS (Rose a)
forall a. Read a => ReadS [Rose a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rose a]
$creadListPrec :: forall a. Read a => ReadPrec [Rose a]
readPrec :: ReadPrec (Rose a)
$creadPrec :: forall a. Read a => ReadPrec (Rose a)
readList :: ReadS [Rose a]
$creadList :: forall a. Read a => ReadS [Rose a]
readsPrec :: Int -> ReadS (Rose a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Rose a)
Read, Int -> Rose a -> ShowS
[Rose a] -> ShowS
Rose a -> String
(Int -> Rose a -> ShowS)
-> (Rose a -> String) -> ([Rose a] -> ShowS) -> Show (Rose a)
forall a. Show a => Int -> Rose a -> ShowS
forall a. Show a => [Rose a] -> ShowS
forall a. Show a => Rose a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rose a] -> ShowS
$cshowList :: forall a. Show a => [Rose a] -> ShowS
show :: Rose a -> String
$cshow :: forall a. Show a => Rose a -> String
showsPrec :: Int -> Rose a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Rose a -> ShowS
Show, Rose a -> Rose a -> Bool
(Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool) -> Eq (Rose a)
forall a. Eq a => Rose a -> Rose a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rose a -> Rose a -> Bool
$c/= :: forall a. Eq a => Rose a -> Rose a -> Bool
== :: Rose a -> Rose a -> Bool
$c== :: forall a. Eq a => Rose a -> Rose a -> Bool
Eq, Eq (Rose a)
Eq (Rose a)
-> (Rose a -> Rose a -> Ordering)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Bool)
-> (Rose a -> Rose a -> Rose a)
-> (Rose a -> Rose a -> Rose a)
-> Ord (Rose a)
Rose a -> Rose a -> Bool
Rose a -> Rose a -> Ordering
Rose a -> Rose a -> Rose a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Rose a)
forall a. Ord a => Rose a -> Rose a -> Bool
forall a. Ord a => Rose a -> Rose a -> Ordering
forall a. Ord a => Rose a -> Rose a -> Rose a
min :: Rose a -> Rose a -> Rose a
$cmin :: forall a. Ord a => Rose a -> Rose a -> Rose a
max :: Rose a -> Rose a -> Rose a
$cmax :: forall a. Ord a => Rose a -> Rose a -> Rose a
>= :: Rose a -> Rose a -> Bool
$c>= :: forall a. Ord a => Rose a -> Rose a -> Bool
> :: Rose a -> Rose a -> Bool
$c> :: forall a. Ord a => Rose a -> Rose a -> Bool
<= :: Rose a -> Rose a -> Bool
$c<= :: forall a. Ord a => Rose a -> Rose a -> Bool
< :: Rose a -> Rose a -> Bool
$c< :: forall a. Ord a => Rose a -> Rose a -> Bool
compare :: Rose a -> Rose a -> Ordering
$ccompare :: forall a. Ord a => Rose a -> Rose a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Rose a)
Ord)

pattern T :: (Ord a) => () => a -> [Rose a] -> Pairing a
pattern $bT :: a -> [Rose a] -> Pairing a
$mT :: forall r a.
Ord a =>
Pairing a -> (a -> [Rose a] -> r) -> (Void# -> r) -> r
T x ts <- Pairing _ (T' x ts) where
  T a
x [Rose a]
ts = (a -> a -> Ordering) -> Rose a -> Pairing a
forall a. (a -> a -> Ordering) -> Rose a -> Pairing a
Pairing a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
T' a
x [Rose a]
ts)

chunksOf :: Int -> [a] -> [[a]]
chunksOf :: Int -> [a] -> [[a]]
chunksOf Int
n = ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (([a] -> Maybe ([a], [a])) -> [a] -> [[a]])
-> ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ \case
  [] -> Maybe ([a], [a])
forall a. Maybe a
Nothing
  [a]
xs -> ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a])) -> ([a], [a]) -> Maybe ([a], [a])
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
{-# INLINE chunksOf #-}

-- | O(1), amortised and worst
singleton :: Ord a => a -> Pairing a
singleton :: a -> Pairing a
singleton a
a = a -> [Rose a] -> Pairing a
forall a. Ord a => a -> [Rose a] -> Pairing a
T a
a []
{-# INLINE singleton #-}

-- | O(1), both amortised and worst, merges two heaps.
merge :: Pairing a -> Pairing a -> Pairing a
merge :: Pairing a -> Pairing a -> Pairing a
merge Pairing a
h     Pairing a
Empty = Pairing a
h
merge Pairing a
Empty Pairing a
h     = Pairing a
h
merge (Pairing a -> a -> Ordering
c Rose a
h1) (Pairing a -> a -> Ordering
_ Rose a
h2) =
  (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Pairing a)
-> Pairing a
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c ((forall s. Reifies s (ReifiedOrd a) => Proxy s -> Pairing a)
 -> Pairing a)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Pairing a)
-> Pairing a
forall a b. (a -> b) -> a -> b
$ \Proxy s
m ->
  (a -> a -> Ordering) -> Rose a -> Pairing a
forall a. (a -> a -> Ordering) -> Rose a -> Pairing a
Pairing a -> a -> Ordering
c (Rose a -> Pairing a) -> Rose a -> Pairing a
forall a b. (a -> b) -> a -> b
$ Rose (ReflectedOrd a s) -> Rose a
coerce (Rose (ReflectedOrd a s) -> Rose a)
-> Rose (ReflectedOrd a s) -> Rose a
forall a b. (a -> b) -> a -> b
$ Rose (ReflectedOrd a s)
-> Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s)
forall a. Ord a => Rose a -> Rose a -> Rose a
merge' (Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
m Rose a
h1) (Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
m Rose a
h2)
{-# INLINE merge #-}

merge' :: Ord a => Rose a -> Rose a -> Rose a
merge' :: Rose a -> Rose a -> Rose a
merge' l :: Rose a
l@(T' a
x [Rose a]
hs) r :: Rose a
r@(T' a
y [Rose a]
hs')
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y    = a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
T' a
x (Rose a
r Rose a -> [Rose a] -> [Rose a]
forall a. a -> [a] -> [a]
: [Rose a]
hs)
  | Bool
otherwise = a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
T' a
y (Rose a
l Rose a -> [Rose a] -> [Rose a]
forall a. a -> [a] -> [a]
: [Rose a]
hs')
{-# INLINE merge' #-}

-- | Synonym for @'merge'@.
union :: Pairing a -> Pairing a -> Pairing a
union :: Pairing a -> Pairing a -> Pairing a
union = Pairing a -> Pairing a -> Pairing a
forall a. Pairing a -> Pairing a -> Pairing a
merge
{-# INLINE union #-}

-- | O(1), both amortised and worst, insert an element into a heap.
insert :: Ord a => a -> Pairing a -> Pairing a
insert :: a -> Pairing a -> Pairing a
insert a
x = Pairing a -> Pairing a -> Pairing a
forall a. Pairing a -> Pairing a -> Pairing a
merge (a -> [Rose a] -> Pairing a
forall a. Ord a => a -> [Rose a] -> Pairing a
T a
x [])
{-# INLINE insert #-}

empty :: Pairing a
empty :: Pairing a
empty = Pairing a
forall a. Pairing a
Empty
{-# INLINE empty #-}

null :: Pairing a -> Bool
null :: Pairing a -> Bool
null Pairing a
Empty = Bool
True
null Pairing a
_     = Bool
False
{-# INLINE null #-}

fromList :: Ord a => [a] -> Pairing a
fromList :: [a] -> Pairing a
fromList = (a -> Pairing a -> Pairing a) -> Pairing a -> [a] -> Pairing a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Pairing a -> Pairing a
forall a. Ord a => a -> Pairing a -> Pairing a
insert Pairing a
forall a. Pairing a
empty
{-# INLINE fromList #-}

-- | O(1), both amortised and worst, find the minimum element.
findMin :: Pairing a -> Maybe a
findMin :: Pairing a -> Maybe a
findMin (Pairing a -> a -> Ordering
_ (T' a
x [Rose a]
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
findMin Pairing a
Empty             = Maybe a
forall a. Maybe a
Nothing
{-# INLINE findMin #-}

merges :: forall a. Ord a => [Rose a] -> Rose a
merges :: [Rose a] -> Rose a
merges [Rose a]
xs = (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Rose a)
-> Rose a
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((forall s. Reifies s (ReifiedOrd a) => Proxy s -> Rose a)
 -> Rose a)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Rose a)
-> Rose a
forall a b. (a -> b) -> a -> b
$ \Proxy s
m ->
  let aux :: [Rose a] -> Rose a
aux [Rose a
x]    = Rose a
x
      aux ~[Rose a
x,Rose a
y] = Rose a -> Rose a -> Rose a
forall a. Ord a => Rose a -> Rose a -> Rose a
merge' Rose a
x Rose a
y
  in Rose (ReflectedOrd a s) -> Rose a
coerce (Rose (ReflectedOrd a s) -> Rose a)
-> Rose (ReflectedOrd a s) -> Rose a
forall a b. (a -> b) -> a -> b
$ (Rose (ReflectedOrd a s)
 -> Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s))
-> [Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Rose (ReflectedOrd a s)
-> Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s)
forall a. Ord a => Rose a -> Rose a -> Rose a
merge' ([Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s))
-> [Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s)
forall a b. (a -> b) -> a -> b
$ ([Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s))
-> [[Rose (ReflectedOrd a s)]] -> [Rose (ReflectedOrd a s)]
forall a b. (a -> b) -> [a] -> [b]
map [Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s)
forall a. Ord a => [Rose a] -> Rose a
aux ([[Rose (ReflectedOrd a s)]] -> [Rose (ReflectedOrd a s)])
-> [[Rose (ReflectedOrd a s)]] -> [Rose (ReflectedOrd a s)]
forall a b. (a -> b) -> a -> b
$
     Int -> [Rose (ReflectedOrd a s)] -> [[Rose (ReflectedOrd a s)]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
2 ([Rose (ReflectedOrd a s)] -> [[Rose (ReflectedOrd a s)]])
-> [Rose (ReflectedOrd a s)] -> [[Rose (ReflectedOrd a s)]]
forall a b. (a -> b) -> a -> b
$ Proxy s -> [Rose a] -> [Rose (ReflectedOrd a s)]
forall s a. Proxy s -> [Rose a] -> [Rose (ReflectedOrd a s)]
castRoses Proxy s
m [Rose a]
xs
{-# INLINE merges #-}

mapMonotonic :: Ord a => (t -> a) -> Pairing t -> Pairing a
mapMonotonic :: (t -> a) -> Pairing t -> Pairing a
mapMonotonic t -> a
_ Pairing t
Empty      = Pairing a
forall a. Pairing a
Empty
mapMonotonic t -> a
f (Pairing t -> t -> Ordering
_ Rose t
t) = (a -> a -> Ordering) -> Rose a -> Pairing a
forall a. (a -> a -> Ordering) -> Rose a -> Pairing a
Pairing a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Rose a -> Pairing a) -> Rose a -> Pairing a
forall a b. (a -> b) -> a -> b
$ (t -> a) -> Rose t -> Rose a
forall t a. (t -> a) -> Rose t -> Rose a
monomap t -> a
f Rose t
t

monomap :: (t -> a) -> Rose t -> Rose a
monomap :: (t -> a) -> Rose t -> Rose a
monomap t -> a
f (T' t
x [Rose t]
rs) = a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
T' (t -> a
f t
x) ([Rose a] -> Rose a) -> [Rose a] -> Rose a
forall a b. (a -> b) -> a -> b
$ (Rose t -> Rose a) -> [Rose t] -> [Rose a]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> a) -> Rose t -> Rose a
forall t a. (t -> a) -> Rose t -> Rose a
monomap t -> a
f) [Rose t]
rs

-- | O(log n) amortised and O(n) worst, removes the least element
--   and returns remainder.
deleteMin :: Pairing a -> Maybe (Pairing a)
deleteMin :: Pairing a -> Maybe (Pairing a)
deleteMin (Pairing a -> a -> Ordering
_ (T' a
_ [])) = Pairing a -> Maybe (Pairing a)
forall a. a -> Maybe a
Just Pairing a
forall a. Pairing a
Empty
deleteMin (Pairing a -> a -> Ordering
c (T' a
_ [Rose a]
xs)) =
  (a -> a -> Ordering)
-> (forall s.
    Reifies s (ReifiedOrd a) =>
    Proxy s -> Maybe (Pairing a))
-> Maybe (Pairing a)
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c ((forall s.
  Reifies s (ReifiedOrd a) =>
  Proxy s -> Maybe (Pairing a))
 -> Maybe (Pairing a))
-> (forall s.
    Reifies s (ReifiedOrd a) =>
    Proxy s -> Maybe (Pairing a))
-> Maybe (Pairing a)
forall a b. (a -> b) -> a -> b
$ \Proxy s
m ->
  Pairing a -> Maybe (Pairing a)
forall a. a -> Maybe a
Just (Pairing a -> Maybe (Pairing a)) -> Pairing a -> Maybe (Pairing a)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> Rose a -> Pairing a
forall a. (a -> a -> Ordering) -> Rose a -> Pairing a
Pairing a -> a -> Ordering
c (Rose a -> Pairing a) -> Rose a -> Pairing a
forall a b. (a -> b) -> a -> b
$ Rose (ReflectedOrd a s) -> Rose a
coerce (Rose (ReflectedOrd a s) -> Rose a)
-> Rose (ReflectedOrd a s) -> Rose a
forall a b. (a -> b) -> a -> b
$ [Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s)
forall a. Ord a => [Rose a] -> Rose a
merges ([Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s))
-> [Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s)
forall a b. (a -> b) -> a -> b
$ Proxy s -> [Rose a] -> [Rose (ReflectedOrd a s)]
forall s a. Proxy s -> [Rose a] -> [Rose (ReflectedOrd a s)]
castRoses Proxy s
m [Rose a]
xs
deleteMin Pairing a
_ = Maybe (Pairing a)
forall a. Maybe a
Nothing
{-# INLINE deleteMin #-}

-- | O(1), amortised and worst, for the least element;
--   O(log n) amortised and O(n) worst for the remainder.
viewMin :: Pairing a -> Maybe (a, Pairing a)
viewMin :: Pairing a -> Maybe (a, Pairing a)
viewMin Pairing a
h = (,) (a -> Pairing a -> (a, Pairing a))
-> Maybe a -> Maybe (Pairing a -> (a, Pairing a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pairing a -> Maybe a
forall a. Pairing a -> Maybe a
findMin Pairing a
h Maybe (Pairing a -> (a, Pairing a))
-> Maybe (Pairing a) -> Maybe (a, Pairing a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pairing a -> Maybe (Pairing a)
forall a. Pairing a -> Maybe (Pairing a)
deleteMin Pairing a
h
{-# INLINE viewMin #-}

-- | Synonym for @'viewMin'@.
uncons :: Ord a => Pairing a -> Maybe (a, Pairing a)
uncons :: Pairing a -> Maybe (a, Pairing a)
uncons = Pairing a -> Maybe (a, Pairing a)
forall a. Pairing a -> Maybe (a, Pairing a)
viewMin
{-# INLINE uncons #-}

instance Semigroup (Pairing a) where
  <> :: Pairing a -> Pairing a -> Pairing a
(<>) = Pairing a -> Pairing a -> Pairing a
forall a. Pairing a -> Pairing a -> Pairing a
merge
  {-# INLINE (<>) #-}

instance Monoid (Pairing a) where
  mappend :: Pairing a -> Pairing a -> Pairing a
mappend = Pairing a -> Pairing a -> Pairing a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}
  mempty :: Pairing a
mempty  = Pairing a
forall a. Pairing a
Empty
  {-# INLINE mempty #-}

insertWith :: (a -> a -> Ordering) -> a -> Pairing a -> Pairing a
insertWith :: (a -> a -> Ordering) -> a -> Pairing a -> Pairing a
insertWith a -> a -> Ordering
c a
x Pairing a
Empty = (a -> a -> Ordering) -> Rose a -> Pairing a
forall a. (a -> a -> Ordering) -> Rose a -> Pairing a
Pairing a -> a -> Ordering
c (a -> [Rose a] -> Rose a
forall a. a -> [Rose a] -> Rose a
T' a
x [])
insertWith a -> a -> Ordering
c a
x (Pairing a -> a -> Ordering
_ Rose a
r) =
  (a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Pairing a)
-> Pairing a
forall a r.
(a -> a -> Ordering)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> r) -> r
reifyOrd a -> a -> Ordering
c ((forall s. Reifies s (ReifiedOrd a) => Proxy s -> Pairing a)
 -> Pairing a)
-> (forall s. Reifies s (ReifiedOrd a) => Proxy s -> Pairing a)
-> Pairing a
forall a b. (a -> b) -> a -> b
$ \Proxy s
m ->
  (a -> a -> Ordering) -> Rose a -> Pairing a
forall a. (a -> a -> Ordering) -> Rose a -> Pairing a
Pairing a -> a -> Ordering
c (Rose a -> Pairing a) -> Rose a -> Pairing a
forall a b. (a -> b) -> a -> b
$ Rose (ReflectedOrd a s) -> Rose a
coerce (Rose (ReflectedOrd a s) -> Rose a)
-> Rose (ReflectedOrd a s) -> Rose a
forall a b. (a -> b) -> a -> b
$ Rose (ReflectedOrd a s)
-> Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s)
forall a. Ord a => Rose a -> Rose a -> Rose a
merge' (ReflectedOrd a s
-> [Rose (ReflectedOrd a s)] -> Rose (ReflectedOrd a s)
forall a. a -> [Rose a] -> Rose a
T' (a -> ReflectedOrd a s
forall a s. a -> ReflectedOrd a s
ReflectedOrd a
x) []) (Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s))
-> Rose (ReflectedOrd a s) -> Rose (ReflectedOrd a s)
forall a b. (a -> b) -> a -> b
$ Proxy s -> Rose a -> Rose (ReflectedOrd a s)
forall s a. Proxy s -> Rose a -> Rose (ReflectedOrd a s)
castRose Proxy s
m Rose a
r
{-# INLINE insertWith #-}

-- | O(n log n), amortised, and O(n^2) worst.
span :: (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
span :: (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
span a -> Bool
_ Pairing a
Empty = (Pairing a
forall a. Pairing a
Empty, Pairing a
forall a. Pairing a
Empty)
span a -> Bool
p h :: Pairing a
h@(Pairing a -> a -> Ordering
c Rose a
_) =
  case Pairing a -> Maybe (a, Pairing a)
forall a. Pairing a -> Maybe (a, Pairing a)
viewMin Pairing a
h of
    Maybe (a, Pairing a)
Nothing -> (Pairing a
forall a. Pairing a
Empty, Pairing a
forall a. Pairing a
Empty)
    Just (a
x, Pairing a
h')
      | a -> Bool
p a
x -> let (Pairing a
as, Pairing a
bs) = (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
forall a. (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
span a -> Bool
p Pairing a
h'
               in ((a -> a -> Ordering) -> a -> Pairing a -> Pairing a
forall a. (a -> a -> Ordering) -> a -> Pairing a -> Pairing a
insertWith a -> a -> Ordering
c a
x Pairing a
as, Pairing a
bs)
      | Bool
otherwise -> (Pairing a
forall a. Pairing a
Empty, Pairing a
h)

instance HC.Heap Pairing where
  null :: Pairing a -> Bool
null  = Pairing a -> Bool
forall a. Pairing a -> Bool
null
  {-# INLINE null #-}
  empty :: Pairing a
empty = Pairing a
forall a. Pairing a
empty
  {-# INLINE empty #-}
  insert :: a -> Pairing a -> Pairing a
insert = a -> Pairing a -> Pairing a
forall a. Ord a => a -> Pairing a -> Pairing a
insert
  {-# INLINE insert #-}
  merge :: Pairing a -> Pairing a -> Pairing a
merge  = Pairing a -> Pairing a -> Pairing a
forall a. Pairing a -> Pairing a -> Pairing a
merge
  {-# INLINE merge #-}
  singleton :: a -> Pairing a
singleton = a -> Pairing a
forall a. Ord a => a -> Pairing a
singleton
  {-# INLINE singleton #-}
  findMin :: Pairing a -> Maybe a
findMin = Pairing a -> Maybe a
forall a. Pairing a -> Maybe a
findMin
  {-# INLINE findMin #-}
  deleteMin :: Pairing a -> Maybe (Pairing a)
deleteMin = Pairing a -> Maybe (Pairing a)
forall a. Pairing a -> Maybe (Pairing a)
deleteMin
  {-# INLINE deleteMin #-}
  viewMin :: Pairing a -> Maybe (a, Pairing a)
viewMin = Pairing a -> Maybe (a, Pairing a)
forall a. Pairing a -> Maybe (a, Pairing a)
viewMin
  {-# INLINE viewMin #-}
  toList :: Pairing a -> [a]
toList = Pairing a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  {-# INLINE toList #-}
  fromList :: [a] -> Pairing a
fromList = [a] -> Pairing a
forall a. Ord a => [a] -> Pairing a
fromList
  {-# INLINE fromList #-}
  span :: (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
span = (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
forall a. (a -> Bool) -> Pairing a -> (Pairing a, Pairing a)
span
  {-# INLINE span #-}