{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) Edward Kmett 2010-2015
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- An efficient, asymptotically optimal, implementation of a priority queues
-- extended with support for efficient size, and `Data.Foldable`
--
-- /Note/: Since many function names (but not the type name) clash with
-- "Prelude" names, this module is usually imported @qualified@, e.g.
--
-- >  import Data.Heap (Heap)
-- >  import qualified Data.Heap as Heap
--
-- The implementation of 'Heap' is based on /bootstrapped skew binomial heaps/
-- as described by:
--
--    * G. Brodal and C. Okasaki , <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.48.973 "Optimal Purely Functional Priority Queues">,
--      /Journal of Functional Programming/ 6:839-857 (1996)
--
-- All time bounds are worst-case.
-----------------------------------------------------------------------------

module Data.Heap
    (
    -- * Heap Type
      Heap -- instance Eq,Ord,Show,Read,Data,Typeable
    -- * Entry type
    , Entry(..) -- instance Eq,Ord,Show,Read,Data,Typeable
    -- * Basic functions
    , empty             -- O(1) :: Heap a
    , null              -- O(1) :: Heap a -> Bool
    , size              -- O(1) :: Heap a -> Int
    , singleton         -- O(1) :: Ord a => a -> Heap a
    , insert            -- O(1) :: Ord a => a -> Heap a -> Heap a
    , minimum           -- O(1) (/partial/) :: Ord a => Heap a -> a
    , deleteMin         -- O(log n) :: Heap a -> Heap a
    , union             -- O(1) :: Heap a -> Heap a -> Heap a
    , uncons, viewMin   -- O(1)\/O(log n) :: Heap a -> Maybe (a, Heap a)
    -- * Transformations
    , mapMonotonic      -- O(n) :: Ord b => (a -> b) -> Heap a -> Heap b
    , map               -- O(n) :: Ord b => (a -> b) -> Heap a -> Heap b
    -- * To/From Lists
    , toUnsortedList    -- O(n) :: Heap a -> [a]
    , fromList          -- O(n) :: Ord a => [a] -> Heap a
    , sort              -- O(n log n) :: Ord a => [a] -> [a]
    , traverse          -- O(n log n) :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b)
    , mapM              -- O(n log n) :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b)
    , concatMap         -- O(n) :: Ord b => Heap a -> (a -> Heap b) -> Heap b
    -- * Filtering
    , filter            -- O(n) :: (a -> Bool) -> Heap a -> Heap a
    , partition         -- O(n) :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
    , split             -- O(n) :: a -> Heap a -> (Heap a, Heap a, Heap a)
    , break             -- O(n log n) :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
    , span              -- O(n log n) :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
    , take              -- O(n log n) :: Int -> Heap a -> Heap a
    , drop              -- O(n log n) :: Int -> Heap a -> Heap a
    , splitAt           -- O(n log n) :: Int -> Heap a -> (Heap a, Heap a)
    , takeWhile         -- O(n log n) :: (a -> Bool) -> Heap a -> Heap a
    , dropWhile         -- O(n log n) :: (a -> Bool) -> Heap a -> Heap a
    -- * Grouping
    , group             -- O(n log n) :: Heap a -> Heap (Heap a)
    , groupBy           -- O(n log n) :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)
    , nub               -- O(n log n) :: Heap a -> Heap a
    -- * Intersection
    , intersect         -- O(n log n + m log m) :: Heap a -> Heap a -> Heap a
    , intersectWith     -- O(n log n + m log m) :: Ord b => (a -> a -> b) -> Heap a -> Heap a -> Heap b
    -- * Duplication
    , replicate         -- O(log n) :: Ord a => a -> Int -> Heap a
    ) where

import Prelude hiding
    ( map
    , span, dropWhile, takeWhile, break, filter, take, drop, splitAt
    , foldr, minimum, replicate, mapM
    , concatMap
#if __GLASGOW_HASKELL__ < 710
    , null
#else
    , traverse
#endif
    )
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor
#endif
import qualified Data.List as L
import Control.Applicative (Applicative(pure))
import Control.Monad (liftM)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Monoid (Monoid(mappend, mempty))
import Data.Foldable hiding (minimum, concatMap)
import Data.Function (on)
import Data.Data (DataType, Constr, mkConstr, mkDataType, Fixity(Prefix), Data(..), constrIndex)
import Data.Typeable (Typeable)
import Text.Read
import Text.Show
import qualified Data.Traversable as Traversable
import Data.Traversable (Traversable)

-- The implementation of 'Heap' must internally hold onto the dictionary entry for ('<='),
-- so that it can be made 'Foldable'. Confluence in the absence of incoherent instances
-- is provided by the fact that we only ever build these from instances of 'Ord' a (except in the case of 'groupBy')


-- | A min-heap of values of type @a@.
data Heap a
  = Empty
  | Heap {-# UNPACK #-} !Int (a -> a -> Bool) {-# UNPACK #-} !(Tree a)
  deriving Typeable

#if __GLASGOW_HASKELL__ >= 707
type role Heap nominal
#endif

instance Show a => Show (Heap a) where
  showsPrec :: Int -> Heap a -> ShowS
showsPrec Int
_ Heap a
Empty = String -> ShowS
showString String
"fromList []"
  showsPrec Int
d (Heap Int
_ a -> a -> Bool
_ Tree a
t) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Tree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Tree a
t)

instance (Ord a, Read a) => Read (Heap a) where
  readPrec :: ReadPrec (Heap a)
readPrec = ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Heap a) -> ReadPrec (Heap a))
-> ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Heap a) -> ReadPrec (Heap a))
-> ReadPrec (Heap a) -> ReadPrec (Heap a)
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"fromList" <- ReadPrec Lexeme
lexP
    [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList ([a] -> Heap a) -> ReadPrec [a] -> ReadPrec (Heap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReadPrec [a] -> ReadPrec [a]
forall a. ReadPrec a -> ReadPrec a
step ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec

instance (Ord a, Data a) => Data (Heap a) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Heap a -> c (Heap a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z Heap a
h = ([a] -> Heap a) -> c ([a] -> Heap a)
forall g. g -> c g
z [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList c ([a] -> Heap a) -> [a] -> c (Heap a)
forall d b. Data d => c (d -> b) -> d -> c b
`k` Heap a -> [a]
forall a. Heap a -> [a]
toUnsortedList Heap a
h
  toConstr :: Heap a -> Constr
toConstr Heap a
_ = Constr
fromListConstr
  dataTypeOf :: Heap a -> DataType
dataTypeOf Heap a
_ = DataType
heapDataType
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Heap a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c ([a] -> Heap a) -> c (Heap a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> Heap a) -> c ([a] -> Heap a)
forall r. r -> c r
z [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList)
    Int
_ -> String -> c (Heap a)
forall a. HasCallStack => String -> a
error String
"gunfold"

heapDataType :: DataType
heapDataType :: DataType
heapDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Heap.Heap" [Constr
fromListConstr]

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
heapDataType String
"fromList" [] Fixity
Prefix

instance Eq (Heap a) where
  Heap a
Empty == :: Heap a -> Heap a -> Bool
== Heap a
Empty = Bool
True
  Heap a
Empty == Heap{} = Bool
False
  Heap{} == Heap a
Empty = Bool
False
  a :: Heap a
a@(Heap Int
s1 a -> a -> Bool
leq Tree a
_) == b :: Heap a
b@(Heap Int
s2 a -> a -> Bool
_ Tree a
_) = Int
s1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s2 Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall t. (t -> t -> Bool) -> [t] -> [t] -> Bool
go a -> a -> Bool
leq (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
    where
      go :: (t -> t -> Bool) -> [t] -> [t] -> Bool
go t -> t -> Bool
f (t
x:[t]
xs) (t
y:[t]
ys) = t -> t -> Bool
f t
x t
y Bool -> Bool -> Bool
&& t -> t -> Bool
f t
y t
x Bool -> Bool -> Bool
&& (t -> t -> Bool) -> [t] -> [t] -> Bool
go t -> t -> Bool
f [t]
xs [t]
ys
      go t -> t -> Bool
_ [] [] = Bool
True
      go t -> t -> Bool
_ [t]
_ [t]
_ = Bool
False

instance Ord (Heap a) where
  Heap a
Empty compare :: Heap a -> Heap a -> Ordering
`compare` Heap a
Empty = Ordering
EQ
  Heap a
Empty `compare` Heap{} = Ordering
LT
  Heap{} `compare` Heap a
Empty = Ordering
GT
  a :: Heap a
a@(Heap Int
_ a -> a -> Bool
leq Tree a
_) `compare` Heap a
b = (a -> a -> Bool) -> [a] -> [a] -> Ordering
forall t. (t -> t -> Bool) -> [t] -> [t] -> Ordering
go a -> a -> Bool
leq (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
    where
      go :: (t -> t -> Bool) -> [t] -> [t] -> Ordering
go t -> t -> Bool
f (t
x:[t]
xs) (t
y:[t]
ys) =
          if t -> t -> Bool
f t
x t
y
          then if t -> t -> Bool
f t
y t
x
               then (t -> t -> Bool) -> [t] -> [t] -> Ordering
go t -> t -> Bool
f [t]
xs [t]
ys
               else Ordering
LT
          else Ordering
GT
      go t -> t -> Bool
f [] []    = Ordering
EQ
      go t -> t -> Bool
f [] (t
_:[t]
_) = Ordering
LT
      go t -> t -> Bool
f (t
_:[t]
_) [] = Ordering
GT



-- | /O(1)/. The empty heap
--
-- @'empty' ≡ 'fromList' []@
--
-- >>> size empty
-- 0
empty :: Heap a
empty :: Heap a
empty = Heap a
forall a. Heap a
Empty
{-# INLINE empty #-}

-- | /O(1)/. A heap with a single element
--
-- @
-- 'singleton' x ≡ 'fromList' [x]
-- 'singleton' x ≡ 'insert' x 'empty'
-- @
--
-- >>> size (singleton "hello")
-- 1
singleton :: Ord a => a -> Heap a
singleton :: a -> Heap a
singleton = (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
{-# INLINE singleton #-}

singletonWith :: (a -> a -> Bool) -> a -> Heap a
singletonWith :: (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
f a
a = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap Int
1 a -> a -> Bool
f (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
a Forest a
forall a. Forest a
Nil)
{-# INLINE singletonWith #-}

-- | /O(1)/. Insert a new value into the heap.
--
-- >>> insert 2 (fromList [1,3])
-- fromList [1,2,3]
--
-- @
-- 'insert' x 'empty' ≡ 'singleton' x
-- 'size' ('insert' x xs) ≡ 1 + 'size' xs
-- @
insert :: Ord a => a -> Heap a -> Heap a
insert :: a -> Heap a -> Heap a
insert = (a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
{-# INLINE insert #-}

insertWith :: (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith :: (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
leq a
x Heap a
Empty = (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x
insertWith a -> a -> Bool
leq a
x (Heap Int
s a -> a -> Bool
_ t :: Tree a
t@(Node Int
_ a
y Forest a
f))
  | a -> a -> Bool
leq a
x a
y   = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x (Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
forall a. Forest a
Nil))
  | Bool
otherwise = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
y ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x Forest a
forall a. Forest a
Nil) Forest a
f))
{-# INLINE insertWith #-}

-- | /O(1)/. Meld the values from two heaps into one heap.
--
-- >>> union (fromList [1,3,5]) (fromList [6,4,2])
-- fromList [1,2,6,4,3,5]
-- >>> union (fromList [1,1,1]) (fromList [1,2,1])
-- fromList [1,1,1,2,1,1]
union :: Heap a -> Heap a -> Heap a
union :: Heap a -> Heap a -> Heap a
union Heap a
Empty Heap a
q = Heap a
q
union Heap a
q Heap a
Empty = Heap a
q
union (Heap Int
s1 a -> a -> Bool
leq t1 :: Tree a
t1@(Node Int
_ a
x1 Forest a
f1)) (Heap Int
s2 a -> a -> Bool
_ t2 :: Tree a
t2@(Node Int
_ a
x2 Forest a
f2))
  | a -> a -> Bool
leq a
x1 a
x2 = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x1 ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq Tree a
t2 Forest a
f1))
  | Bool
otherwise = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x2 ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq Tree a
t1 Forest a
f2))
{-# INLINE union #-}

-- | /O(log n)/. Create a heap consisting of multiple copies of the same value.
--
-- >>> replicate 'a' 10
-- fromList "aaaaaaaaaa"
replicate :: Ord a => a -> Int -> Heap a
replicate :: a -> Int -> Heap a
replicate a
x0 Int
y0
  | Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Heap a
forall a. HasCallStack => String -> a
error String
"Heap.replicate: negative length"
  | Int
y0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Heap a
forall a. Monoid a => a
mempty
  | Bool
otherwise = Heap a -> Int -> Heap a
forall a a. Integral a => Heap a -> a -> Heap a
f (a -> Heap a
forall a. Ord a => a -> Heap a
singleton a
x0) Int
y0
  where
    f :: Heap a -> a -> Heap a
f Heap a
x a
y
        | a -> Bool
forall a. Integral a => a -> Bool
even a
y = Heap a -> a -> Heap a
f (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot a
y a
2)
        | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = Heap a
x
        | Bool
otherwise = Heap a -> a -> Heap a -> Heap a
forall a a. Integral a => Heap a -> a -> Heap a -> Heap a
g (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
2) Heap a
x
    g :: Heap a -> a -> Heap a -> Heap a
g Heap a
x a
y Heap a
z
        | a -> Bool
forall a. Integral a => a -> Bool
even a
y = Heap a -> a -> Heap a -> Heap a
g (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot a
y a
2) Heap a
z
        | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
z
        | Bool
otherwise = Heap a -> a -> Heap a -> Heap a
g (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
x) (a -> a -> a
forall a. Integral a => a -> a -> a
quot (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
2) (Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union Heap a
x Heap a
z)
{-# INLINE replicate #-}

-- | Provides both /O(1)/ access to the minimum element and /O(log n)/ access to the remainder of the heap.
-- This is the same operation as 'viewMin'
--
-- >>> uncons (fromList [2,1,3])
-- Just (1,fromList [2,3])
uncons :: Heap a -> Maybe (a, Heap a)
uncons :: Heap a -> Maybe (a, Heap a)
uncons Heap a
Empty = Maybe (a, Heap a)
forall a. Maybe a
Nothing
uncons l :: Heap a
l@(Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a, Heap a) -> Maybe (a, Heap a)
forall a. a -> Maybe a
Just (Tree a -> a
forall a. Tree a -> a
root Tree a
t, Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
l)
{-# INLINE uncons #-}

-- | Same as 'uncons'
viewMin :: Heap a -> Maybe (a, Heap a)
viewMin :: Heap a -> Maybe (a, Heap a)
viewMin = Heap a -> Maybe (a, Heap a)
forall a. Heap a -> Maybe (a, Heap a)
uncons
{-# INLINE viewMin #-}

-- | /O(1)/. Assumes the argument is a non-'null' heap.
--
-- >>> minimum (fromList [3,1,2])
-- 1
minimum :: Heap a -> a
minimum :: Heap a -> a
minimum Heap a
Empty = String -> a
forall a. HasCallStack => String -> a
error String
"Heap.minimum: empty heap"
minimum (Heap Int
_ a -> a -> Bool
_ Tree a
t) = Tree a -> a
forall a. Tree a -> a
root Tree a
t
{-# INLINE minimum #-}

trees :: Forest a -> [Tree a]
trees :: Forest a -> [Tree a]
trees (Tree a
a `Cons` Forest a
as) = Tree a
a Tree a -> [Tree a] -> [Tree a]
forall a. a -> [a] -> [a]
: Forest a -> [Tree a]
forall a. Forest a -> [Tree a]
trees Forest a
as
trees Forest a
Nil = []

-- | /O(log n)/. Delete the minimum key from the heap and return the resulting heap.
--
-- >>> deleteMin (fromList [3,1,2])
-- fromList [2,3]
deleteMin :: Heap a -> Heap a
deleteMin :: Heap a -> Heap a
deleteMin Heap a
Empty = Heap a
forall a. Heap a
Empty
deleteMin (Heap Int
_ a -> a -> Bool
_ (Node Int
_ a
_ Forest a
Nil)) = Heap a
forall a. Heap a
Empty
deleteMin (Heap Int
s a -> a -> Bool
leq (Node Int
_ a
_ Forest a
f0)) = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
0 a
x Forest a
f3)
  where
    (Node Int
r a
x Forest a
cf, Forest a
ts2) = (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
forall a. (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin a -> a -> Bool
leq Forest a
f0
    (Forest a
zs, Forest a
ts1, Forest a
f1) = Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
forall a.
Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest Int
r Forest a
forall a. Forest a
Nil Forest a
forall a. Forest a
Nil Forest a
cf
    f2 :: Forest a
f2 = (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld a -> a -> Bool
leq ((a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld a -> a -> Bool
leq Forest a
ts1 Forest a
ts2) Forest a
f1
    f3 :: Forest a
f3 = (Tree a -> Forest a -> Forest a)
-> Forest a -> [Tree a] -> Forest a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
leq) Forest a
f2 (Forest a -> [Tree a]
forall a. Forest a -> [Tree a]
trees Forest a
zs)
{-# INLINE deleteMin #-}

-- | /O(log n)/. Adjust the minimum key in the heap and return the resulting heap.
--
-- >>> adjustMin (+1) (fromList [1,2,3])
-- fromList [2,2,3]
adjustMin :: (a -> a) -> Heap a -> Heap a
adjustMin :: (a -> a) -> Heap a -> Heap a
adjustMin a -> a
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
adjustMin a -> a
f (Heap Int
s a -> a -> Bool
leq (Node Int
r a
x Forest a
xs)) = Int -> (a -> a -> Bool) -> Tree a -> Heap a
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap Int
s a -> a -> Bool
leq ((a -> a -> Bool) -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a
heapify a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
r (a -> a
f a
x) Forest a
xs))
{-# INLINE adjustMin #-}

type ForestZipper a = (Forest a, Forest a)

zipper :: Forest a -> ForestZipper a
zipper :: Forest a -> ForestZipper a
zipper Forest a
xs = (Forest a
forall a. Forest a
Nil, Forest a
xs)
{-# INLINE zipper #-}

emptyZ :: ForestZipper a
emptyZ :: ForestZipper a
emptyZ = (Forest a
forall a. Forest a
Nil, Forest a
forall a. Forest a
Nil)
{-# INLINE emptyZ #-}

-- leftZ :: ForestZipper a -> ForestZipper a
-- leftZ (x :> path, xs) = (path, x :> xs)

rightZ :: ForestZipper a -> ForestZipper a
rightZ :: ForestZipper a -> ForestZipper a
rightZ (Forest a
path, Tree a
x `Cons` Forest a
xs) = (Tree a
x Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
path, Forest a
xs)
{-# INLINE rightZ #-}

adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a
adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a
adjustZ Tree a -> Tree a
f (Forest a
path, Tree a
x `Cons` Forest a
xs) = (Forest a
path, Tree a -> Tree a
f Tree a
x Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
xs)
adjustZ Tree a -> Tree a
_ ForestZipper a
z = ForestZipper a
z
{-# INLINE adjustZ #-}

rezip :: ForestZipper a -> Forest a
rezip :: ForestZipper a -> Forest a
rezip (Forest a
Nil, Forest a
xs) = Forest a
xs
rezip (Tree a
x `Cons` Forest a
path, Forest a
xs) = ForestZipper a -> Forest a
forall a. ForestZipper a -> Forest a
rezip (Forest a
path, Tree a
x Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
xs)

-- assumes non-empty zipper
rootZ :: ForestZipper a -> a
rootZ :: ForestZipper a -> a
rootZ (Forest a
_ , Tree a
x `Cons` Forest a
_) = Tree a -> a
forall a. Tree a -> a
root Tree a
x
rootZ ForestZipper a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"Heap.rootZ: empty zipper"
{-# INLINE rootZ #-}

minZ :: (a -> a -> Bool) -> Forest a -> ForestZipper a
minZ :: (a -> a -> Bool) -> Forest a -> ForestZipper a
minZ a -> a -> Bool
_ Forest a
Nil = ForestZipper a
forall a. ForestZipper a
emptyZ
minZ a -> a -> Bool
f Forest a
xs = (a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
forall a.
(a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' a -> a -> Bool
f ForestZipper a
z ForestZipper a
z
    where z :: ForestZipper a
z = Forest a -> ForestZipper a
forall a. Forest a -> ForestZipper a
zipper Forest a
xs
{-# INLINE minZ #-}

minZ' :: (a -> a -> Bool) -> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' :: (a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' a -> a -> Bool
_ ForestZipper a
lo (Forest a
_, Forest a
Nil) = ForestZipper a
lo
minZ' a -> a -> Bool
leq ForestZipper a
lo ForestZipper a
z = (a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
forall a.
(a -> a -> Bool)
-> ForestZipper a -> ForestZipper a -> ForestZipper a
minZ' a -> a -> Bool
leq (if a -> a -> Bool
leq (ForestZipper a -> a
forall a. ForestZipper a -> a
rootZ ForestZipper a
lo) (ForestZipper a -> a
forall a. ForestZipper a -> a
rootZ ForestZipper a
z) then ForestZipper a
lo else ForestZipper a
z) (ForestZipper a -> ForestZipper a
forall a. ForestZipper a -> ForestZipper a
rightZ ForestZipper a
z)

heapify :: (a -> a -> Bool) -> Tree a -> Tree a
heapify :: (a -> a -> Bool) -> Tree a -> Tree a
heapify a -> a -> Bool
_ n :: Tree a
n@(Node Int
_ a
_ Forest a
Nil) = Tree a
n
heapify a -> a -> Bool
leq n :: Tree a
n@(Node Int
r a
a Forest a
as)
  | a -> a -> Bool
leq a
a a
a' = Tree a
n
  | Bool
otherwise = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
r a
a' (ForestZipper a -> Forest a
forall a. ForestZipper a -> Forest a
rezip (Forest a
left, (a -> a -> Bool) -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a
heapify a -> a -> Bool
leq (Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node Int
r' a
a Forest a
as') Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
right))
  where
    (Forest a
left, Node Int
r' a
a' Forest a
as' `Cons` Forest a
right) = (a -> a -> Bool) -> Forest a -> ForestZipper a
forall a. (a -> a -> Bool) -> Forest a -> ForestZipper a
minZ a -> a -> Bool
leq Forest a
as


-- | /O(n)/. Build a heap from a list of values.
--
-- @
-- 'fromList' '.' 'toList' ≡ 'id'
-- 'toList' '.' 'fromList' ≡ 'sort'
-- @

-- >>> size (fromList [1,5,3])
-- 3
fromList :: Ord a => [a] -> Heap a
fromList :: [a] -> Heap a
fromList = (a -> Heap a -> Heap a) -> Heap a -> [a] -> Heap a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Heap a -> Heap a
forall a. Ord a => a -> Heap a -> Heap a
insert Heap a
forall a. Monoid a => a
mempty
{-# INLINE fromList #-}

fromListWith :: (a -> a -> Bool) -> [a] -> Heap a
fromListWith :: (a -> a -> Bool) -> [a] -> Heap a
fromListWith a -> a -> Bool
f = (a -> Heap a -> Heap a) -> Heap a -> [a] -> Heap a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
f) Heap a
forall a. Monoid a => a
mempty
{-# INLINE fromListWith #-}

-- | /O(n log n)/. Perform a heap sort
sort :: Ord a => [a] -> [a]
sort :: [a] -> [a]
sort = Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Heap a -> [a]) -> ([a] -> Heap a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Heap a
forall a. Ord a => [a] -> Heap a
fromList
{-# INLINE sort #-}

#if MIN_VERSION_base(4,9,0)
instance Semigroup (Heap a) where
  <> :: Heap a -> Heap a -> Heap a
(<>) = Heap a -> Heap a -> Heap a
forall a. Heap a -> Heap a -> Heap a
union
  {-# INLINE (<>) #-}
#endif

instance Monoid (Heap a) where
  mempty :: Heap a
mempty = Heap a
forall a. Heap a
empty
  {-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
  mappend = union
  {-# INLINE mappend #-}
#endif

-- | /O(n)/. Returns the elements in the heap in some arbitrary, very likely unsorted, order.
--
-- >>> toUnsortedList (fromList [3,1,2])
-- [1,3,2]
--
-- @'fromList' '.' 'toUnsortedList' ≡ 'id'@
toUnsortedList :: Heap a -> [a]
toUnsortedList :: Heap a -> [a]
toUnsortedList Heap a
Empty = []
toUnsortedList (Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a -> [a]) -> Tree a -> [a]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Tree a
t
{-# INLINE toUnsortedList #-}

instance Foldable Heap where
  foldMap :: (a -> m) -> Heap a -> m
foldMap a -> m
_ Heap a
Empty = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f l :: Heap a
l@(Heap Int
_ a -> a -> Bool
_ Tree a
t) = a -> m
f (Tree a -> a
forall a. Tree a -> a
root Tree a
t) m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Heap a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
l)
#if __GLASGOW_HASKELL__ >= 710
  null :: Heap a -> Bool
null Heap a
Empty = Bool
True
  null Heap a
_ = Bool
False

  length :: Heap a -> Int
length = Heap a -> Int
forall a. Heap a -> Int
size
#else

-- | /O(1)/. Is the heap empty?
--
-- >>> null empty
-- True
--
-- >>> null (singleton "hello")
-- False
null :: Heap a -> Bool
null Empty = True
null _ = False
{-# INLINE null #-}

#endif

-- | /O(1)/. The number of elements in the heap.
--
-- >>> size empty
-- 0
-- >>> size (singleton "hello")
-- 1
-- >>> size (fromList [4,1,2])
-- 3
size :: Heap a -> Int
size :: Heap a -> Int
size Heap a
Empty = Int
0
size (Heap Int
s a -> a -> Bool
_ Tree a
_) = Int
s
{-# INLINE size #-}

-- | /O(n)/. Map a function over the heap, returning a new heap ordered appropriately for its fresh contents
--
-- >>> map negate (fromList [3,1,2])
-- fromList [-3,-1,-2]
map :: Ord b => (a -> b) -> Heap a -> Heap b
map :: (a -> b) -> Heap a -> Heap b
map a -> b
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
map a -> b
f (Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a -> Heap b) -> Tree a -> Heap b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (b -> Heap b
forall a. Ord a => a -> Heap a
singleton (b -> Heap b) -> (a -> b) -> a -> Heap b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Tree a
t
{-# INLINE map #-}

-- | /O(n)/. Map a monotone increasing function over the heap.
-- Provides a better constant factor for performance than 'map', but no checking is performed that the function provided is monotone increasing. Misuse of this function can cause a Heap to violate the heap property.
--
-- >>> mapMonotonic (+1) (fromList [1,2,3])
-- fromList [2,3,4]
-- >>> mapMonotonic (*2) (fromList [1,2,3])
-- fromList [2,4,6]
mapMonotonic :: Ord b => (a -> b) -> Heap a -> Heap b
mapMonotonic :: (a -> b) -> Heap a -> Heap b
mapMonotonic a -> b
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
mapMonotonic a -> b
f (Heap Int
s a -> a -> Bool
_ Tree a
t) = Int -> (b -> b -> Bool) -> Tree b -> Heap b
forall a. Int -> (a -> a -> Bool) -> Tree a -> Heap a
Heap Int
s b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ((a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Tree a
t)
{-# INLINE mapMonotonic #-}

-- * Filter

-- | /O(n)/. Filter the heap, retaining only values that satisfy the predicate.
--
-- >>> filter (>'a') (fromList "ab")
-- fromList "b"
-- >>> filter (>'x') (fromList "ab")
-- fromList []
-- >>> filter (<'a') (fromList "ab")
-- fromList []
filter :: (a -> Bool) -> Heap a -> Heap a
filter :: (a -> Bool) -> Heap a -> Heap a
filter a -> Bool
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
filter a -> Bool
p (Heap Int
_ a -> a -> Bool
leq Tree a
t) = (a -> Heap a) -> Tree a -> Heap a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Heap a
f Tree a
t
  where
    f :: a -> Heap a
f a
x | a -> Bool
p a
x = (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x
        | Bool
otherwise = Heap a
forall a. Heap a
Empty
{-# INLINE filter #-}

-- | /O(n)/. Partition the heap according to a predicate. The first heap contains all elements that satisfy the predicate, the second all elements that fail the predicate. See also 'split'.
--
-- >>> partition (>'a') (fromList "ab")
-- (fromList "b",fromList "a")
partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
partition a -> Bool
_ Heap a
Empty = (Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty)
partition a -> Bool
p (Heap Int
_ a -> a -> Bool
leq Tree a
t) = (a -> (Heap a, Heap a)) -> Tree a -> (Heap a, Heap a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> (Heap a, Heap a)
f Tree a
t
  where
    f :: a -> (Heap a, Heap a)
f a
x | a -> Bool
p a
x       = ((a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x, Heap a
forall a. Monoid a => a
mempty)
        | Bool
otherwise = (Heap a
forall a. Monoid a => a
mempty, (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x)
{-# INLINE partition #-}

-- | /O(n)/. Partition the heap into heaps of the elements that are less than, equal to, and greater than a given value.
--
-- >>> split 'h' (fromList "hello")
-- (fromList "e",fromList "h",fromList "llo")
split :: a -> Heap a -> (Heap a, Heap a, Heap a)
split :: a -> Heap a -> (Heap a, Heap a, Heap a)
split a
a Heap a
Empty = (Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty)
split a
a (Heap Int
s a -> a -> Bool
leq Tree a
t) = (a -> (Heap a, Heap a, Heap a))
-> Tree a -> (Heap a, Heap a, Heap a)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> (Heap a, Heap a, Heap a)
f Tree a
t
  where
    f :: a -> (Heap a, Heap a, Heap a)
f a
x = if a -> a -> Bool
leq a
x a
a
          then if a -> a -> Bool
leq a
a a
x
               then (Heap a
forall a. Monoid a => a
mempty, (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x, Heap a
forall a. Monoid a => a
mempty)
               else ((a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x, Heap a
forall a. Monoid a => a
mempty, Heap a
forall a. Monoid a => a
mempty)
          else (Heap a
forall a. Monoid a => a
mempty, Heap a
forall a. Monoid a => a
mempty, (a -> a -> Bool) -> a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a
singletonWith a -> a -> Bool
leq a
x)
{-# INLINE split #-}

-- * Subranges

-- | /O(n log n)/. Return a heap consisting of the least @n@ elements of a given heap.
--
-- >>> take 3 (fromList [10,2,4,1,9,8,2])
-- fromList [1,2,2]
take :: Int -> Heap a -> Heap a
take :: Int -> Heap a -> Heap a
take = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> (Int -> [a] -> [a]) -> Int -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take
{-# INLINE take #-}

-- | /O(n log n)/. Return a heap consisting of all members of given heap except for the @n@ least elements.
drop :: Int -> Heap a -> Heap a
drop :: Int -> Heap a -> Heap a
drop = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> (Int -> [a] -> [a]) -> Int -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop
{-# INLINE drop #-}

-- | /O(n log n)/. Split a heap into two heaps, the first containing the @n@ least elements, the latter consisting of all members of the heap except for those elements.
splitAt :: Int -> Heap a -> (Heap a, Heap a)
splitAt :: Int -> Heap a -> (Heap a, Heap a)
splitAt = ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
forall a. ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList (([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a))
-> (Int -> [a] -> ([a], [a])) -> Int -> Heap a -> (Heap a, Heap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
L.splitAt
{-# INLINE splitAt #-}

-- | /O(n log n)/. 'break' applied to a predicate @p@ and a heap @xs@ returns a tuple where the first element is a heap consisting of the
-- longest prefix the least elements of @xs@ that /do not satisfy/ p and the second element is the remainder of the elements in the heap.
--
-- >>> break (\x -> x `mod` 4 == 0) (fromList [3,5,7,12,13,16])
-- (fromList [3,5,7],fromList [12,13,16])
--
-- 'break' @p@ is equivalent to @'span' ('not' . p)@.
break :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
break :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
break = ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
forall a. ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList (([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a))
-> ((a -> Bool) -> [a] -> ([a], [a]))
-> (a -> Bool)
-> Heap a
-> (Heap a, Heap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break
{-# INLINE break #-}

-- | /O(n log n)/. 'span' applied to a predicate @p@ and a heap @xs@ returns a tuple where the first element is a heap consisting of the
-- longest prefix the least elements of xs that satisfy @p@ and the second element is the remainder of the elements in the heap.
--
-- >>> span (\x -> x `mod` 4 == 0) (fromList [4,8,12,14,16])
-- (fromList [4,8,12],fromList [14,16])
--
-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@

span :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
span :: (a -> Bool) -> Heap a -> (Heap a, Heap a)
span = ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
forall a. ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList (([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a))
-> ((a -> Bool) -> [a] -> ([a], [a]))
-> (a -> Bool)
-> Heap a
-> (Heap a, Heap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span
{-# INLINE span #-}

-- | /O(n log n)/. 'takeWhile' applied to a predicate @p@ and a heap @xs@ returns a heap consisting of the
-- longest prefix the least elements of @xs@ that satisfy @p@.
--
-- >>> takeWhile (\x -> x `mod` 4 == 0) (fromList [4,8,12,14,16])
-- fromList [4,8,12]
takeWhile :: (a -> Bool) -> Heap a -> Heap a
takeWhile :: (a -> Bool) -> Heap a -> Heap a
takeWhile = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> ((a -> Bool) -> [a] -> [a]) -> (a -> Bool) -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.takeWhile
{-# INLINE takeWhile #-}

-- | /O(n log n)/. 'dropWhile' @p xs@ returns the suffix of the heap remaining after 'takeWhile' @p xs@.
--
-- >>> dropWhile (\x -> x `mod` 4 == 0) (fromList [4,8,12,14,16])
-- fromList [14,16]
dropWhile :: (a -> Bool) -> Heap a -> Heap a
dropWhile :: (a -> Bool) -> Heap a -> Heap a
dropWhile = ([a] -> [a]) -> Heap a -> Heap a
forall a. ([a] -> [a]) -> Heap a -> Heap a
withList (([a] -> [a]) -> Heap a -> Heap a)
-> ((a -> Bool) -> [a] -> [a]) -> (a -> Bool) -> Heap a -> Heap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile
{-# INLINE dropWhile #-}

-- | /O(n log n)/. Remove duplicate entries from the heap.
--
-- >>> nub (fromList [1,1,2,6,6])
-- fromList [1,2,6]
nub :: Heap a -> Heap a
nub :: Heap a -> Heap a
nub Heap a
Empty = Heap a
forall a. Heap a
Empty
nub h :: Heap a
h@(Heap Int
_ a -> a -> Bool
leq Tree a
t) = (a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
leq a
x (Heap a -> Heap a
forall a. Heap a -> Heap a
nub Heap a
zs)
  where
    x :: a
x = Tree a -> a
forall a. Tree a -> a
root Tree a
t
    xs :: Heap a
xs = Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
h
    zs :: Heap a
zs = (a -> Bool) -> Heap a -> Heap a
forall a. (a -> Bool) -> Heap a -> Heap a
dropWhile (a -> a -> Bool
`leq` a
x) Heap a
xs
{-# INLINE nub #-}

-- | /O(n)/. Construct heaps from each element in another heap, and union them together.
--
-- >>> concatMap (\a -> fromList [a,a+1]) (fromList [1,4])
-- fromList [1,4,5,2]
concatMap :: (a -> Heap b) -> Heap a -> Heap b
concatMap :: (a -> Heap b) -> Heap a -> Heap b
concatMap a -> Heap b
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
concatMap a -> Heap b
f h :: Heap a
h@(Heap Int
_ a -> a -> Bool
_ Tree a
t) = (a -> Heap b) -> Tree a -> Heap b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Heap b
f Tree a
t
{-# INLINE concatMap #-}

-- | /O(n log n)/. Group a heap into a heap of heaps, by unioning together duplicates.
--
-- >>> group (fromList "hello")
-- fromList [fromList "e",fromList "h",fromList "ll",fromList "o"]
group :: Heap a -> Heap (Heap a)
group :: Heap a -> Heap (Heap a)
group Heap a
Empty = Heap (Heap a)
forall a. Heap a
Empty
group h :: Heap a
h@(Heap Int
_ a -> a -> Bool
leq Tree a
_) = (a -> a -> Bool) -> Heap a -> Heap (Heap a)
forall a. (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy ((a -> a -> Bool) -> a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Bool
leq) Heap a
h
{-# INLINE group #-}

-- | /O(n log n)/. Group using a user supplied function.
groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy :: (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy a -> a -> Bool
f Heap a
Empty = Heap (Heap a)
forall a. Heap a
Empty
groupBy a -> a -> Bool
f h :: Heap a
h@(Heap Int
_ a -> a -> Bool
leq Tree a
t) = Heap a -> Heap (Heap a) -> Heap (Heap a)
forall a. Ord a => a -> Heap a -> Heap a
insert ((a -> a -> Bool) -> a -> Heap a -> Heap a
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith a -> a -> Bool
leq a
x Heap a
ys) ((a -> a -> Bool) -> Heap a -> Heap (Heap a)
forall a. (a -> a -> Bool) -> Heap a -> Heap (Heap a)
groupBy a -> a -> Bool
f Heap a
zs)
  where
    x :: a
x = Tree a -> a
forall a. Tree a -> a
root Tree a
t
    xs :: Heap a
xs = Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
h
    (Heap a
ys,Heap a
zs) = (a -> Bool) -> Heap a -> (Heap a, Heap a)
forall a. (a -> Bool) -> Heap a -> (Heap a, Heap a)
span (a -> a -> Bool
f a
x) Heap a
xs
{-# INLINE groupBy #-}

-- | /O(n log n + m log m)/. Intersect the values in two heaps, returning the value in the left heap that compares as equal
intersect :: Heap a -> Heap a -> Heap a
intersect :: Heap a -> Heap a -> Heap a
intersect Heap a
Empty Heap a
_ = Heap a
forall a. Heap a
Empty
intersect Heap a
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
intersect a :: Heap a
a@(Heap Int
_ a -> a -> Bool
leq Tree a
_) Heap a
b = (a -> a -> Bool) -> [a] -> [a] -> Heap a
forall t. (t -> t -> Bool) -> [t] -> [t] -> Heap t
go a -> a -> Bool
leq (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
  where
    go :: (t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' xxs :: [t]
xxs@(t
x:[t]
xs) yys :: [t]
yys@(t
y:[t]
ys) =
        if t -> t -> Bool
leq' t
x t
y
        then if t -> t -> Bool
leq' t
y t
x
             then (t -> t -> Bool) -> t -> Heap t -> Heap t
forall a. (a -> a -> Bool) -> a -> Heap a -> Heap a
insertWith t -> t -> Bool
leq' t
x ((t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' [t]
xs [t]
ys)
             else (t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' [t]
xs [t]
yys
        else (t -> t -> Bool) -> [t] -> [t] -> Heap t
go t -> t -> Bool
leq' [t]
xxs [t]
ys
    go t -> t -> Bool
_ [] [t]
_ = Heap t
forall a. Heap a
empty
    go t -> t -> Bool
_ [t]
_ [] = Heap t
forall a. Heap a
empty
{-# INLINE intersect #-}

-- | /O(n log n + m log m)/. Intersect the values in two heaps using a function to generate the elements in the right heap.
intersectWith :: Ord b => (a -> a -> b) -> Heap a -> Heap a -> Heap b
intersectWith :: (a -> a -> b) -> Heap a -> Heap a -> Heap b
intersectWith a -> a -> b
_ Heap a
Empty Heap a
_ = Heap b
forall a. Heap a
Empty
intersectWith a -> a -> b
_ Heap a
_ Heap a
Empty = Heap b
forall a. Heap a
Empty
intersectWith a -> a -> b
f a :: Heap a
a@(Heap Int
_ a -> a -> Bool
leq Tree a
_) Heap a
b = (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq a -> a -> b
f (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
b)
  where
    go :: Ord b => (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
    go :: (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' xxs :: [a]
xxs@(a
x:[a]
xs) yys :: [a]
yys@(a
y:[a]
ys)
        | a -> a -> Bool
leq' a
x a
y =
            if a -> a -> Bool
leq' a
y a
x
            then b -> Heap b -> Heap b
forall a. Ord a => a -> Heap a -> Heap a
insert (a -> a -> b
f' a
x a
y) ((a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' [a]
xs [a]
ys)
            else (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' [a]
xs [a]
yys
        | Bool
otherwise = (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
forall b a.
Ord b =>
(a -> a -> Bool) -> (a -> a -> b) -> [a] -> [a] -> Heap b
go a -> a -> Bool
leq' a -> a -> b
f' [a]
xxs [a]
ys
    go a -> a -> Bool
_ a -> a -> b
_ [] [a]
_ = Heap b
forall a. Heap a
empty
    go a -> a -> Bool
_ a -> a -> b
_ [a]
_ [] = Heap b
forall a. Heap a
empty
{-# INLINE intersectWith #-}

-- | /O(n log n)/. Traverse the elements of the heap in sorted order and produce a new heap using 'Applicative' side-effects.
traverse :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b)
traverse :: (a -> t b) -> Heap a -> t (Heap b)
traverse a -> t b
f = ([b] -> Heap b) -> t [b] -> t (Heap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> Heap b
forall a. Ord a => [a] -> Heap a
fromList (t [b] -> t (Heap b)) -> (Heap a -> t [b]) -> Heap a -> t (Heap b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> t b) -> [a] -> t [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Traversable.traverse a -> t b
f ([a] -> t [b]) -> (Heap a -> [a]) -> Heap a -> t [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE traverse #-}

-- | /O(n log n)/. Traverse the elements of the heap in sorted order and produce a new heap using 'Monad'ic side-effects.
mapM :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b)
mapM :: (a -> m b) -> Heap a -> m (Heap b)
mapM a -> m b
f = ([b] -> Heap b) -> m [b] -> m (Heap b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [b] -> Heap b
forall a. Ord a => [a] -> Heap a
fromList (m [b] -> m (Heap b)) -> (Heap a -> m [b]) -> Heap a -> m (Heap b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> [a] -> m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Traversable.mapM a -> m b
f ([a] -> m [b]) -> (Heap a -> [a]) -> Heap a -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# INLINE mapM #-}

both :: (a -> b) -> (a, a) -> (b, b)
both :: (a -> b) -> (a, a) -> (b, b)
both a -> b
f (a
a,a
b) = (a -> b
f a
a, a -> b
f a
b)
{-# INLINE both #-}

-- we hold onto the children counts in the nodes for /O(1)/ 'size'
data Tree a = Node
  { Tree a -> Int
rank :: {-# UNPACK #-} !Int
  , Tree a -> a
root :: a
  , Tree a -> Forest a
_forest :: !(Forest a)
  } deriving (Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show,ReadPrec [Tree a]
ReadPrec (Tree a)
Int -> ReadS (Tree a)
ReadS [Tree a]
(Int -> ReadS (Tree a))
-> ReadS [Tree a]
-> ReadPrec (Tree a)
-> ReadPrec [Tree a]
-> Read (Tree a)
forall a. Read a => ReadPrec [Tree a]
forall a. Read a => ReadPrec (Tree a)
forall a. Read a => Int -> ReadS (Tree a)
forall a. Read a => ReadS [Tree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tree a]
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readPrec :: ReadPrec (Tree a)
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readList :: ReadS [Tree a]
$creadList :: forall a. Read a => ReadS [Tree a]
readsPrec :: Int -> ReadS (Tree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
Read,Typeable)

data Forest a = !(Tree a) `Cons` !(Forest a) | Nil
  deriving (Int -> Forest a -> ShowS
[Forest a] -> ShowS
Forest a -> String
(Int -> Forest a -> ShowS)
-> (Forest a -> String) -> ([Forest a] -> ShowS) -> Show (Forest a)
forall a. Show a => Int -> Forest a -> ShowS
forall a. Show a => [Forest a] -> ShowS
forall a. Show a => Forest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Forest a] -> ShowS
$cshowList :: forall a. Show a => [Forest a] -> ShowS
show :: Forest a -> String
$cshow :: forall a. Show a => Forest a -> String
showsPrec :: Int -> Forest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Forest a -> ShowS
Show,ReadPrec [Forest a]
ReadPrec (Forest a)
Int -> ReadS (Forest a)
ReadS [Forest a]
(Int -> ReadS (Forest a))
-> ReadS [Forest a]
-> ReadPrec (Forest a)
-> ReadPrec [Forest a]
-> Read (Forest a)
forall a. Read a => ReadPrec [Forest a]
forall a. Read a => ReadPrec (Forest a)
forall a. Read a => Int -> ReadS (Forest a)
forall a. Read a => ReadS [Forest a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Forest a]
$creadListPrec :: forall a. Read a => ReadPrec [Forest a]
readPrec :: ReadPrec (Forest a)
$creadPrec :: forall a. Read a => ReadPrec (Forest a)
readList :: ReadS [Forest a]
$creadList :: forall a. Read a => ReadS [Forest a]
readsPrec :: Int -> ReadS (Forest a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Forest a)
Read,Typeable)
infixr 5 `Cons`

instance Functor Tree where
  fmap :: (a -> b) -> Tree a -> Tree b
fmap a -> b
f (Node Int
r a
a Forest a
as) = Int -> b -> Forest b -> Tree b
forall a. Int -> a -> Forest a -> Tree a
Node Int
r (a -> b
f a
a) ((a -> b) -> Forest a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Forest a
as)

instance Functor Forest where
  fmap :: (a -> b) -> Forest a -> Forest b
fmap a -> b
f (Tree a
a `Cons` Forest a
as) = (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Tree a
a Tree b -> Forest b -> Forest b
forall a. Tree a -> Forest a -> Forest a
`Cons` (a -> b) -> Forest a -> Forest b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Forest a
as
  fmap a -> b
_ Forest a
Nil = Forest b
forall a. Forest a
Nil

-- internal foldable instances that should only be used over commutative monoids
instance Foldable Tree where
  foldMap :: (a -> m) -> Tree a -> m
foldMap a -> m
f (Node Int
_ a
a Forest a
as) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Forest a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Forest a
as

-- internal foldable instances that should only be used over commutative monoids
instance Foldable Forest where
  foldMap :: (a -> m) -> Forest a -> m
foldMap a -> m
f (Tree a
a `Cons` Forest a
as) = (a -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Tree a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Forest a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Forest a
as
  foldMap a -> m
_ Forest a
Nil = m
forall a. Monoid a => a
mempty

link :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link a -> a -> Bool
f t1 :: Tree a
t1@(Node Int
r1 a
x1 Forest a
cf1) t2 :: Tree a
t2@(Node Int
r2 a
x2 Forest a
cf2) -- assumes r1 == r2
  | a -> a -> Bool
f a
x1 a
x2   = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x1 (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf1)
  | Bool
otherwise = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x2 (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf2)

skewLink :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
skewLink :: (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
skewLink a -> a -> Bool
f t0 :: Tree a
t0@(Node Int
_ a
x0 Forest a
cf0) t1 :: Tree a
t1@(Node Int
r1 a
x1 Forest a
cf1) t2 :: Tree a
t2@(Node Int
r2 a
x2 Forest a
cf2)
  | a -> a -> Bool
f a
x1 a
x0 Bool -> Bool -> Bool
&& a -> a -> Bool
f a
x1 a
x2 = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x1 (Tree a
t0 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf1)
  | a -> a -> Bool
f a
x2 a
x0 Bool -> Bool -> Bool
&& a -> a -> Bool
f a
x2 a
x1 = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x2 (Tree a
t0 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf2)
  | Bool
otherwise          = Int -> a -> Forest a -> Tree a
forall a. Int -> a -> Forest a -> Tree a
Node (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x0 (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf0)

ins :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
_ Tree a
t Forest a
Nil = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
forall a. Forest a
Nil
ins a -> a -> Bool
f Tree a
t (Tree a
t' `Cons` Forest a
ts) -- assumes rank t <= rank t'
  | Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t' = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t' Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts
  | Bool
otherwise = (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
f ((a -> a -> Bool) -> Tree a -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link a -> a -> Bool
f Tree a
t Tree a
t') Forest a
ts

uniqify :: (a -> a -> Bool) -> Forest a -> Forest a
uniqify :: (a -> a -> Bool) -> Forest a -> Forest a
uniqify a -> a -> Bool
_ Forest a
Nil = Forest a
forall a. Forest a
Nil
uniqify a -> a -> Bool
f (Tree a
t `Cons` Forest a
ts) = (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
f Tree a
t Forest a
ts

unionUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
_ Forest a
Nil Forest a
ts = Forest a
ts
unionUniq a -> a -> Bool
_ Forest a
ts Forest a
Nil = Forest a
ts
unionUniq a -> a -> Bool
f tts1 :: Forest a
tts1@(Tree a
t1 `Cons` Forest a
ts1) tts2 :: Forest a
tts2@(Tree a
t2 `Cons` Forest a
ts2) = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t1) (Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t2) of
  Ordering
LT -> Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f Forest a
ts1 Forest a
tts2
  Ordering
EQ -> (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
ins a -> a -> Bool
f ((a -> a -> Bool) -> Tree a -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a -> Tree a
link a -> a -> Bool
f Tree a
t1 Tree a
t2) ((a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f Forest a
ts1 Forest a
ts2)
  Ordering
GT -> Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f Forest a
tts1 Forest a
ts2

skewInsert :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a
skewInsert a -> a -> Bool
f Tree a
t ts :: Forest a
ts@(Tree a
t1 `Cons` Tree a
t2 `Cons`Forest a
rest)
  | Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t2 = (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
forall a. (a -> a -> Bool) -> Tree a -> Tree a -> Tree a -> Tree a
skewLink a -> a -> Bool
f Tree a
t Tree a
t1 Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
rest
  | Bool
otherwise = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts
skewInsert a -> a -> Bool
_ Tree a
t Forest a
ts = Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts
{-# INLINE skewInsert #-}

skewMeld :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
skewMeld a -> a -> Bool
f Forest a
ts Forest a
ts' = (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a -> Forest a
unionUniq a -> a -> Bool
f ((a -> a -> Bool) -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a
uniqify a -> a -> Bool
f Forest a
ts) ((a -> a -> Bool) -> Forest a -> Forest a
forall a. (a -> a -> Bool) -> Forest a -> Forest a
uniqify a -> a -> Bool
f Forest a
ts')
{-# INLINE skewMeld #-}

getMin :: (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin :: (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin a -> a -> Bool
_ (Tree a
t `Cons` Forest a
Nil) = (Tree a
t, Forest a
forall a. Forest a
Nil)
getMin a -> a -> Bool
f (Tree a
t `Cons` Forest a
ts)
  | a -> a -> Bool
f (Tree a -> a
forall a. Tree a -> a
root Tree a
t) (Tree a -> a
forall a. Tree a -> a
root Tree a
t') = (Tree a
t, Forest a
ts)
  | Bool
otherwise            = (Tree a
t', Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts')
  where (Tree a
t',Forest a
ts') = (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
forall a. (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)
getMin a -> a -> Bool
f Forest a
ts
getMin a -> a -> Bool
_ Forest a
Nil = String -> (Tree a, Forest a)
forall a. HasCallStack => String -> a
error String
"Heap.getMin: empty forest"

splitForest :: Int -> Forest a -> Forest a -> Forest a -> (Forest a, Forest a, Forest a)
splitForest :: Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest Int
a Forest a
b Forest a
c Forest a
d | Int
a Int -> Bool -> Bool
`seq` Forest a
b Forest a -> Bool -> Bool
`seq` Forest a
c Forest a -> Bool -> Bool
`seq` Forest a
d Forest a -> Bool -> Bool
`seq` Bool
False = (Forest a, Forest a, Forest a)
forall a. HasCallStack => a
undefined
splitForest Int
0 Forest a
zs Forest a
ts Forest a
f = (Forest a
zs, Forest a
ts, Forest a
f)
splitForest Int
1 Forest a
zs Forest a
ts (Tree a
t `Cons` Forest a
Nil) = (Forest a
zs, Tree a
t Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Forest a
forall a. Forest a
Nil)
splitForest Int
1 Forest a
zs Forest a
ts (Tree a
t1 `Cons` Tree a
t2 `Cons` Forest a
f)
  -- rank t1 == 0
  | Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
zs, Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Forest a
f)
  | Bool
otherwise    = (Forest a
zs, Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
f)
splitForest Int
r Forest a
zs Forest a
ts (Tree a
t1 `Cons` Tree a
t2 `Cons` Forest a
cf)
  -- r1 = r - 1 or r1 == 0
  | Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2          = (Forest a
zs, Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts, Forest a
cf)
  | Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0           = Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
forall a.
Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
zs) (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts) Forest a
cf
  | Bool
otherwise         = Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
forall a.
Int
-> Forest a
-> Forest a
-> Forest a
-> (Forest a, Forest a, Forest a)
splitForest (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Forest a
zs (Tree a
t1 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
ts) (Tree a
t2 Tree a -> Forest a -> Forest a
forall a. Tree a -> Forest a -> Forest a
`Cons` Forest a
cf)
  where
    r1 :: Int
r1 = Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t1
    r2 :: Int
r2 = Tree a -> Int
forall a. Tree a -> Int
rank Tree a
t2
splitForest Int
_ Forest a
_ Forest a
_ Forest a
_ = String -> (Forest a, Forest a, Forest a)
forall a. HasCallStack => String -> a
error String
"Heap.splitForest: invalid arguments"

withList :: ([a] -> [a]) -> Heap a -> Heap a
withList :: ([a] -> [a]) -> Heap a -> Heap a
withList [a] -> [a]
_ Heap a
Empty = Heap a
forall a. Heap a
Empty
withList [a] -> [a]
f hp :: Heap a
hp@(Heap Int
_ a -> a -> Bool
leq Tree a
_) = (a -> a -> Bool) -> [a] -> Heap a
forall a. (a -> a -> Bool) -> [a] -> Heap a
fromListWith a -> a -> Bool
leq ([a] -> [a]
f (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
hp))
{-# INLINE withList #-}

splitWithList :: ([a] -> ([a],[a])) -> Heap a -> (Heap a, Heap a)
splitWithList :: ([a] -> ([a], [a])) -> Heap a -> (Heap a, Heap a)
splitWithList [a] -> ([a], [a])
_ Heap a
Empty = (Heap a
forall a. Heap a
Empty, Heap a
forall a. Heap a
Empty)
splitWithList [a] -> ([a], [a])
f hp :: Heap a
hp@(Heap Int
_ a -> a -> Bool
leq Tree a
_) = ([a] -> Heap a) -> ([a], [a]) -> (Heap a, Heap a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both ((a -> a -> Bool) -> [a] -> Heap a
forall a. (a -> a -> Bool) -> [a] -> Heap a
fromListWith a -> a -> Bool
leq) ([a] -> ([a], [a])
f (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Heap a
hp))
{-# INLINE splitWithList #-}

-- | Explicit priority/payload tuples. Useful to build a priority queue using
-- a 'Heap', since the payload is ignored in the Eq/Ord instances.
--
-- @
-- myHeap = 'fromList' ['Entry' 2 \"World", 'Entry' 1 \"Hello", 'Entry' 3 "!"]
--
-- ==> 'foldMap' 'payload' myHeap ≡ "HelloWorld!"
-- @
data Entry p a = Entry { Entry p a -> p
priority :: p, Entry p a -> a
payload :: a }
  deriving (ReadPrec [Entry p a]
ReadPrec (Entry p a)
Int -> ReadS (Entry p a)
ReadS [Entry p a]
(Int -> ReadS (Entry p a))
-> ReadS [Entry p a]
-> ReadPrec (Entry p a)
-> ReadPrec [Entry p a]
-> Read (Entry p a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p a. (Read p, Read a) => ReadPrec [Entry p a]
forall p a. (Read p, Read a) => ReadPrec (Entry p a)
forall p a. (Read p, Read a) => Int -> ReadS (Entry p a)
forall p a. (Read p, Read a) => ReadS [Entry p a]
readListPrec :: ReadPrec [Entry p a]
$creadListPrec :: forall p a. (Read p, Read a) => ReadPrec [Entry p a]
readPrec :: ReadPrec (Entry p a)
$creadPrec :: forall p a. (Read p, Read a) => ReadPrec (Entry p a)
readList :: ReadS [Entry p a]
$creadList :: forall p a. (Read p, Read a) => ReadS [Entry p a]
readsPrec :: Int -> ReadS (Entry p a)
$creadsPrec :: forall p a. (Read p, Read a) => Int -> ReadS (Entry p a)
Read,Int -> Entry p a -> ShowS
[Entry p a] -> ShowS
Entry p a -> String
(Int -> Entry p a -> ShowS)
-> (Entry p a -> String)
-> ([Entry p a] -> ShowS)
-> Show (Entry p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> Entry p a -> ShowS
forall p a. (Show p, Show a) => [Entry p a] -> ShowS
forall p a. (Show p, Show a) => Entry p a -> String
showList :: [Entry p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [Entry p a] -> ShowS
show :: Entry p a -> String
$cshow :: forall p a. (Show p, Show a) => Entry p a -> String
showsPrec :: Int -> Entry p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> Entry p a -> ShowS
Show,Typeable (Entry p a)
DataType
Constr
Typeable (Entry p a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Entry p a -> c (Entry p a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Entry p a))
-> (Entry p a -> Constr)
-> (Entry p a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Entry p a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Entry p a)))
-> ((forall b. Data b => b -> b) -> Entry p a -> Entry p a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Entry p a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Entry p a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Entry p a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Entry p a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a))
-> Data (Entry p a)
Entry p a -> DataType
Entry p a -> Constr
(forall b. Data b => b -> b) -> Entry p a -> Entry p a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Entry p a -> u
forall u. (forall d. Data d => d -> u) -> Entry p a -> [u]
forall p a. (Data p, Data a) => Typeable (Entry p a)
forall p a. (Data p, Data a) => Entry p a -> DataType
forall p a. (Data p, Data a) => Entry p a -> Constr
forall p a.
(Data p, Data a) =>
(forall b. Data b => b -> b) -> Entry p a -> Entry p a
forall p a u.
(Data p, Data a) =>
Int -> (forall d. Data d => d -> u) -> Entry p a -> u
forall p a u.
(Data p, Data a) =>
(forall d. Data d => d -> u) -> Entry p a -> [u]
forall p a r r'.
(Data p, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall p a r r'.
(Data p, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall p a (m :: * -> *).
(Data p, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall p a (c :: * -> *).
(Data p, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
forall p a (c :: * -> *).
(Data p, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
forall p a (t :: * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
forall p a (t :: * -> * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
$cEntry :: Constr
$tEntry :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
$cgmapMo :: forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
gmapMp :: (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
$cgmapMp :: forall p a (m :: * -> *).
(Data p, Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
gmapM :: (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
$cgmapM :: forall p a (m :: * -> *).
(Data p, Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Entry p a -> u
$cgmapQi :: forall p a u.
(Data p, Data a) =>
Int -> (forall d. Data d => d -> u) -> Entry p a -> u
gmapQ :: (forall d. Data d => d -> u) -> Entry p a -> [u]
$cgmapQ :: forall p a u.
(Data p, Data a) =>
(forall d. Data d => d -> u) -> Entry p a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
$cgmapQr :: forall p a r r'.
(Data p, Data a) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
$cgmapQl :: forall p a r r'.
(Data p, Data a) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Entry p a -> r
gmapT :: (forall b. Data b => b -> b) -> Entry p a -> Entry p a
$cgmapT :: forall p a.
(Data p, Data a) =>
(forall b. Data b => b -> b) -> Entry p a -> Entry p a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
$cdataCast2 :: forall p a (t :: * -> * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Entry p a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
$cdataCast1 :: forall p a (t :: * -> *) (c :: * -> *).
(Data p, Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Entry p a))
dataTypeOf :: Entry p a -> DataType
$cdataTypeOf :: forall p a. (Data p, Data a) => Entry p a -> DataType
toConstr :: Entry p a -> Constr
$ctoConstr :: forall p a. (Data p, Data a) => Entry p a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
$cgunfold :: forall p a (c :: * -> *).
(Data p, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Entry p a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
$cgfoldl :: forall p a (c :: * -> *).
(Data p, Data a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry p a -> c (Entry p a)
$cp1Data :: forall p a. (Data p, Data a) => Typeable (Entry p a)
Data,Typeable)

instance Functor (Entry p) where
  fmap :: (a -> b) -> Entry p a -> Entry p b
fmap a -> b
f (Entry p
p a
a) = p -> b -> Entry p b
forall p a. p -> a -> Entry p a
Entry p
p (a -> b
f a
a)
  {-# INLINE fmap #-}

#if MIN_VERSION_base(4,8,0)
instance Bifunctor Entry where
  bimap :: (a -> b) -> (c -> d) -> Entry a c -> Entry b d
bimap a -> b
f c -> d
g (Entry a
p c
a) = b -> d -> Entry b d
forall p a. p -> a -> Entry p a
Entry (a -> b
f a
p) (c -> d
g c
a)
#endif

instance Foldable (Entry p) where
  foldMap :: (a -> m) -> Entry p a -> m
foldMap a -> m
f (Entry p
_ a
a) = a -> m
f a
a
  {-# INLINE foldMap #-}

instance Traversable (Entry p) where
  traverse :: (a -> f b) -> Entry p a -> f (Entry p b)
traverse a -> f b
f (Entry p
p a
a) = p -> b -> Entry p b
forall p a. p -> a -> Entry p a
Entry p
p (b -> Entry p b) -> f b -> f (Entry p b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` a -> f b
f a
a
  {-# INLINE traverse #-}

-- instance Comonad (Entry p) where
--   extract (Entry _ a) = a
--   extend f pa@(Entry p _) Entry p (f pa)

instance Eq p => Eq (Entry p a) where
  == :: Entry p a -> Entry p a -> Bool
(==) = p -> p -> Bool
forall a. Eq a => a -> a -> Bool
(==) (p -> p -> Bool)
-> (Entry p a -> p) -> Entry p a -> Entry p a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entry p a -> p
forall p a. Entry p a -> p
priority
  {-# INLINE (==) #-}

instance Ord p => Ord (Entry p a) where
  compare :: Entry p a -> Entry p a -> Ordering
compare = p -> p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (p -> p -> Ordering)
-> (Entry p a -> p) -> Entry p a -> Entry p a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Entry p a -> p
forall p a. Entry p a -> p
priority
  {-# INLINE compare #-}