{-# 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
    , adjustMin         -- O(log n) :: (a -> a) -> 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, null
#if MIN_VERSION_base(4,8,0)
    , traverse
#endif
    )
import Control.Monad (liftM)
import Data.Data (DataType, Constr, mkConstr, mkDataType, Fixity(Prefix), Data(..), constrIndex)
import qualified Data.Foldable as F
import Data.Function (on)
import qualified Data.List as L
import qualified Data.Traversable as T
import Data.Typeable (Typeable)
import Text.Read

#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor
#else
import Control.Applicative (Applicative)
import Data.Foldable (Foldable)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Traversable (Traversable)
#endif

#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

-- $setup
-- >>> let break     = Data.Heap.break
-- >>> let concatMap = Data.Heap.concatMap
-- >>> let dropWhile = Data.Heap.dropWhile
-- >>> let filter    = Data.Heap.filter
-- >>> let minimum   = Data.Heap.minimum
-- >>> let null      = Data.Heap.null
-- >>> let span      = Data.Heap.span
-- >>> let take      = Data.Heap.take
-- >>> let takeWhile = Data.Heap.takeWhile
--
-- -- GHC 7.0 and 7.2 will default the `Ord` constraints to () in the types of
-- -- the following functions unless we give them explicit type signatures.
-- >>> let { map :: Ord b => (a -> b) -> Heap a -> Heap b; map = Data.Heap.map }
-- >>> let { replicate :: Ord a => a -> Int -> Heap a ; replicate = Data.Heap.replicate }

-- 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]
F.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]
F.toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.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]
F.toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.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
_ [] []    = Ordering
EQ
      go t -> t -> Bool
_ [] (t
_:[t]
_) = Ordering
LT
      go t -> t -> Bool
_ (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
F.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)
rightZ ForestZipper a
_ = String -> ForestZipper a
forall a. HasCallStack => String -> a
error String
"Heap.rightZ: empty zipper"
{-# INLINE rightZ #-}

-- adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a
-- adjustZ f (path, x `Cons` xs) = (path, f x `Cons` xs)
-- adjustZ _ z = 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
F.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
F.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]
F.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
F.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
F.foldMap a -> m
f (Heap a -> Heap a
forall a. Heap a -> Heap a
deleteMin Heap a
l)
#if MIN_VERSION_base(4,8,0)
  null :: Heap a -> Bool
null = Heap a -> Bool
forall a. Heap a -> Bool
null
  length :: Heap a -> Int
length = Heap a -> Int
forall a. Heap a -> Int
size
#endif

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

-- | /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
F.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
F.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
F.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
_ 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
_ 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
F.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 (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
F.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
_ 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]
F.toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.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]
F.toList Heap a
a) (Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.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)
T.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]
F.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)
T.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]
F.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
F.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
F.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
F.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]
F.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]
F.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 #-}