{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}

-- |
--
-- Module      :  Data.Heap.Stable
-- Copyright   :  (C) 2015-2016 Jake McArthur
-- License     :  MIT
-- Maintainer  :  Jake.McArthur@gmail.com
-- Stability   :  experimental
--
-- A simple implementation of stable heaps (fair priority queues), modeled as a
-- sequence of key-value pairs, allowing duplicates, with efficient access to
-- the leftmost key-value pair having the smallest key.
--
-- The data structure is a modification of the lazy pairing heaps described in
-- Chris Okasaki's /Purely Functional Data Structures/.
--
-- A 'Heap' has both heap-like and sequence-like properties. Most of the
-- traversals defined in this module work in sequence order; those that work in
-- key order are explicitly documented as such.
--
-- Unless stated otherwise, the documented asymptotic efficiencies of functions
-- on 'Heap' assume that arguments are already in WHNF and that the result is to
-- be evaluated to WHNF.
module Data.Heap.Stable
       ( -- $setup
         Heap ()
         -- * Query
       , Data.Heap.Stable.null
       , size
         -- * Construction
       , empty
       , singleton
       , append
       , appends
       , cons
       , snoc
         -- * Minimum view
       , MinView (..)
       , minView
         -- * Traversal
         -- ** Map
       , bimap
       , mapKeys
       , mapWithKey
       , traverseKeys
       , traverseWithKey
         -- ** Fold
       , foldrWithKey
       , foldMapWithKey
         -- * List operations
         -- ** Conversion from lists
       , fromList
         -- ** Conversion to lists
       , toList
       , toAscList
       ) where

import Prelude hiding (null)

import qualified Control.Applicative as Applicative
import Control.Applicative hiding (Alternative (..))
import Control.Monad
import Data.List (foldl', unfoldr)
import qualified Data.List
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)

import qualified GHC.Exts

#if MIN_VERSION_base(4,9,0)
-- Data.Semigroup was added in base-4.9
import Data.Semigroup as Sem
#endif
#if !(MIN_VERSION_base(4,8,0))
-- starting with base-4.8, Monoid is rexported from Prelude
import Data.Monoid
#endif

-- |
--
-- @Heap k a@ is equivalent to @[(k, a)]@, but its operations have different
-- efficiencies.
data Heap k a
  = Heap !Int !(Heap k a) (Heap k a) !k a (Heap k a) !(Heap k a)
  | Empty
  deriving ((forall a b. (a -> b) -> Heap k a -> Heap k b)
-> (forall a b. a -> Heap k b -> Heap k a) -> Functor (Heap k)
forall a b. a -> Heap k b -> Heap k a
forall a b. (a -> b) -> Heap k a -> Heap k b
forall k a b. a -> Heap k b -> Heap k a
forall k a b. (a -> b) -> Heap k a -> Heap k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> Heap k a -> Heap k b
fmap :: forall a b. (a -> b) -> Heap k a -> Heap k b
$c<$ :: forall k a b. a -> Heap k b -> Heap k a
<$ :: forall a b. a -> Heap k b -> Heap k a
Functor, (forall m. Monoid m => Heap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> Heap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> Heap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> Heap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> Heap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> Heap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> Heap k a -> b)
-> (forall a. (a -> a -> a) -> Heap k a -> a)
-> (forall a. (a -> a -> a) -> Heap k a -> a)
-> (forall a. Heap k a -> [a])
-> (forall a. Heap k a -> Bool)
-> (forall a. Heap k a -> Int)
-> (forall a. Eq a => a -> Heap k a -> Bool)
-> (forall a. Ord a => Heap k a -> a)
-> (forall a. Ord a => Heap k a -> a)
-> (forall a. Num a => Heap k a -> a)
-> (forall a. Num a => Heap k a -> a)
-> Foldable (Heap k)
forall a. Eq a => a -> Heap k a -> Bool
forall a. Num a => Heap k a -> a
forall a. Ord a => Heap k a -> a
forall m. Monoid m => Heap k m -> m
forall a. Heap k a -> Bool
forall a. Heap k a -> Int
forall a. Heap k a -> [a]
forall a. (a -> a -> a) -> Heap k a -> a
forall k a. Eq a => a -> Heap k a -> Bool
forall k a. Num a => Heap k a -> a
forall k a. Ord a => Heap k a -> a
forall m a. Monoid m => (a -> m) -> Heap k a -> m
forall k m. Monoid m => Heap k m -> m
forall k a. Heap k a -> Bool
forall k a. Heap k a -> Int
forall k a. Heap k a -> [a]
forall b a. (b -> a -> b) -> b -> Heap k a -> b
forall a b. (a -> b -> b) -> b -> Heap k a -> b
forall k a. (a -> a -> a) -> Heap k a -> a
forall k m a. Monoid m => (a -> m) -> Heap k a -> m
forall k b a. (b -> a -> b) -> b -> Heap k a -> b
forall k a b. (a -> b -> b) -> b -> Heap k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall k m. Monoid m => Heap k m -> m
fold :: forall m. Monoid m => Heap k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> Heap k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Heap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> Heap k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Heap k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> Heap k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Heap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> Heap k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Heap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> Heap k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Heap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> Heap k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Heap k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> Heap k a -> a
foldr1 :: forall a. (a -> a -> a) -> Heap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> Heap k a -> a
foldl1 :: forall a. (a -> a -> a) -> Heap k a -> a
$ctoList :: forall k a. Heap k a -> [a]
toList :: forall a. Heap k a -> [a]
$cnull :: forall k a. Heap k a -> Bool
null :: forall a. Heap k a -> Bool
$clength :: forall k a. Heap k a -> Int
length :: forall a. Heap k a -> Int
$celem :: forall k a. Eq a => a -> Heap k a -> Bool
elem :: forall a. Eq a => a -> Heap k a -> Bool
$cmaximum :: forall k a. Ord a => Heap k a -> a
maximum :: forall a. Ord a => Heap k a -> a
$cminimum :: forall k a. Ord a => Heap k a -> a
minimum :: forall a. Ord a => Heap k a -> a
$csum :: forall k a. Num a => Heap k a -> a
sum :: forall a. Num a => Heap k a -> a
$cproduct :: forall k a. Num a => Heap k a -> a
product :: forall a. Num a => Heap k a -> a
Foldable, Functor (Heap k)
Foldable (Heap k)
Functor (Heap k)
-> Foldable (Heap k)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Heap k a -> f (Heap k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Heap k (f a) -> f (Heap k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Heap k a -> m (Heap k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Heap k (m a) -> m (Heap k a))
-> Traversable (Heap k)
forall k. Functor (Heap k)
forall k. Foldable (Heap k)
forall k (m :: * -> *) a. Monad m => Heap k (m a) -> m (Heap k a)
forall k (f :: * -> *) a.
Applicative f =>
Heap k (f a) -> f (Heap k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Heap k a -> m (Heap k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Heap k a -> f (Heap k b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Heap k (m a) -> m (Heap k a)
forall (f :: * -> *) a.
Applicative f =>
Heap k (f a) -> f (Heap k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Heap k a -> m (Heap k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Heap k a -> f (Heap k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Heap k a -> f (Heap k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Heap k a -> f (Heap k b)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
Heap k (f a) -> f (Heap k a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Heap k (f a) -> f (Heap k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Heap k a -> m (Heap k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Heap k a -> m (Heap k b)
$csequence :: forall k (m :: * -> *) a. Monad m => Heap k (m a) -> m (Heap k a)
sequence :: forall (m :: * -> *) a. Monad m => Heap k (m a) -> m (Heap k a)
Traversable)

-- |
--
-- 'True' if the 'Heap' is empty and 'False' otherwise.
--
-- /O(1)/.
--
-- >>> any null [the, quick, brown, fox]
-- False
--
-- >>> null empty
-- True
--
-- prop> null xs == Data.List.null (toList xs)
null :: Heap k a -> Bool
null :: forall k a. Heap k a -> Bool
null Heap k a
Empty = Bool
True
null Heap {} = Bool
False

-- |
--
-- The number of key-value pairs in the heap.
--
-- /O(1)/.
--
-- >>> map size [the, quick, brown, fox]
-- [3,5,5,3]
--
-- >>> size empty
-- 0
--
-- prop> size xs == length (toList xs)
size :: Heap k a -> Int
size :: forall k a. Heap k a -> Int
size Heap k a
Empty = Int
0
size (Heap Int
s Heap k a
_ Heap k a
_ k
_ a
_ Heap k a
_ Heap k a
_) = Int
s

-- |
-- An empty heap.
--
-- >>> empty
-- fromList []
empty :: Heap k a
empty :: forall k a. Heap k a
empty = Heap k a
forall k a. Heap k a
Empty

-- |
--
-- Construct a heap containing a single key-value pair.
--
-- /O(1)/.
--
-- >>> singleton "foo" 42
-- fromList [("foo",42)]
--
-- prop> toList (singleton k v) == [(k, v)]
singleton :: k -> a -> Heap k a
singleton :: forall k a. k -> a -> Heap k a
singleton k
k a
v = Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap Int
1 Heap k a
forall k a. Heap k a
empty Heap k a
forall k a. Heap k a
empty k
k a
v Heap k a
forall k a. Heap k a
empty Heap k a
forall k a. Heap k a
empty

-- |
--
-- Append two heaps, preserving sequential ordering.
--
-- /O(1)/.
--
-- >>> append empty the
-- fromList [('t',0),('h',1),('e',2)]
--
-- >>> append the empty
-- fromList [('t',0),('h',1),('e',2)]
--
-- >>> append the fox
-- fromList [('t',0),('h',1),('e',2),('f',0),('o',1),('x',2)]
--
-- prop> toList (xs `append` ys) == toList xs ++ toList ys
append :: Ord k => Heap k a -> Heap k a -> Heap k a
Heap k a
Empty append :: forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
ys = Heap k a
ys
Heap k a
xs `append` Heap k a
Empty = Heap k a
xs
xs :: Heap k a
xs@(Heap Int
sx Heap k a
l1 Heap k a
ls1 k
k1 a
v1 Heap k a
rs1 Heap k a
r1) `append` ys :: Heap k a
ys@(Heap Int
sy Heap k a
l2 Heap k a
ls2 k
k2 a
v2 Heap k a
rs2 Heap k a
r2)
  | k
k1 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
k2 =
      case Heap k a
r1 of
        Heap k a
Empty   -> Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap (Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sy) Heap k a
l1 Heap k a
ls1 k
k1 a
v1  Heap k a
rs1                     Heap k a
ys
        Heap {} -> Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap (Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sy) Heap k a
l1 Heap k a
ls1 k
k1 a
v1 (Heap k a
rs1 Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k a
r1 Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
ys)) Heap k a
forall k a. Heap k a
Empty
  | Bool
otherwise =
      case Heap k a
l2 of
        Heap k a
Empty   -> Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap (Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sy)        Heap k a
xs                        Heap k a
ls2  k
k2 a
v2 Heap k a
rs2 Heap k a
r2
        Heap {} -> Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap (Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sy) Heap k a
forall k a. Heap k a
Empty ((Heap k a
xs Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
l2) Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
ls2) k
k2 a
v2 Heap k a
rs2 Heap k a
r2

-- |
--
-- Sequentially append an arbitrary number of heaps.
--
-- /O(m)/, where /m/ is the length of the input list.
--
-- >>> appends [the, quick, fox]
-- fromList [('t',0),('h',1),('e',2),('q',0),('u',1),('i',2),('c',3),('k',4),('f',0),('o',1),('x',2)]
--
-- prop> toList (appends xss) == concatMap toList xss
appends :: Ord k => [Heap k a] -> Heap k a
appends :: forall k a. Ord k => [Heap k a] -> Heap k a
appends = (Heap k a -> Heap k a -> Heap k a)
-> Heap k a -> [Heap k a] -> Heap k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
append Heap k a
forall k a. Heap k a
empty

-- |
--
-- View of the minimum key of a heap, split out from everything occurring to its
-- left and to its right in the sequence.
data MinView k v
  = EmptyView
  | MinView (Heap k v) k v (Heap k v)
  deriving (MinView k v -> MinView k v -> Bool
(MinView k v -> MinView k v -> Bool)
-> (MinView k v -> MinView k v -> Bool) -> Eq (MinView k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => MinView k v -> MinView k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => MinView k v -> MinView k v -> Bool
== :: MinView k v -> MinView k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => MinView k v -> MinView k v -> Bool
/= :: MinView k v -> MinView k v -> Bool
Eq, Int -> MinView k v -> ShowS
[MinView k v] -> ShowS
MinView k v -> String
(Int -> MinView k v -> ShowS)
-> (MinView k v -> String)
-> ([MinView k v] -> ShowS)
-> Show (MinView k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> MinView k v -> ShowS
forall k v. (Show k, Show v) => [MinView k v] -> ShowS
forall k v. (Show k, Show v) => MinView k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> MinView k v -> ShowS
showsPrec :: Int -> MinView k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => MinView k v -> String
show :: MinView k v -> String
$cshowList :: forall k v. (Show k, Show v) => [MinView k v] -> ShowS
showList :: [MinView k v] -> ShowS
Show)

-- |
--
-- Split the 'Heap' at the /leftmost/ occurrence of the smallest key contained
-- in the 'Heap'.
--
-- When the 'Heap' is empty, /O(1)/. When the 'Heap' is not empty, finding the
-- key and value is /O(1)/, and evaluating the remainder of the heap to the left
-- or right of the key-value pair is amortized /O(log n)/.
--
-- >>> minView empty
-- EmptyView
--
-- >>> minView the
-- MinView (fromList [('t',0),('h',1)]) 'e' 2 (fromList [])
--
-- >>> minView (append the the)
-- MinView (fromList [('t',0),('h',1)]) 'e' 2 (fromList [('t',0),('h',1),('e',2)])
--
-- >>> minView quick
-- MinView (fromList [('q',0),('u',1),('i',2)]) 'c' 3 (fromList [('k',4)])
--
-- >>> minView brown
-- MinView (fromList []) 'b' 0 (fromList [('r',1),('o',2),('w',3),('n',4)])
--
-- >>> minView fox
-- MinView (fromList []) 'f' 0 (fromList [('o',1),('x',2)])
--
-- Here is a model implementation of 'minView':
--
-- >>> :{
-- let { minViewModel xs =
--         case toList xs of
--           []        -> EmptyView
--           keyValues ->
--             let minKey          = minimum (map fst keyValues)
--                 (l, (k, v) : r) = break (\(key, _) -> key == minKey) keyValues
--             in MinView (fromList l) k v (fromList r)
--     }
-- :}
--
-- The following property looks different from the others in this module due to
-- working around a limitation of doctest.
--
-- >>> quickCheck $ \xs -> minView (xs :: Heap Integer Integer) == minViewModel xs
-- +++ OK, passed 100 tests.
minView :: Ord k => Heap k a -> MinView k a
minView :: forall k a. Ord k => Heap k a -> MinView k a
minView Heap k a
Empty = MinView k a
forall k v. MinView k v
EmptyView
minView (Heap Int
_ Heap k a
l Heap k a
ls k
k a
v Heap k a
rs Heap k a
r) = Heap k a -> k -> a -> Heap k a -> MinView k a
forall k v. Heap k v -> k -> v -> Heap k v -> MinView k v
MinView (Heap k a
l Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
ls) k
k a
v (Heap k a
rs Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
r)

#if MIN_VERSION_base(4,9,0)
instance Ord k => Sem.Semigroup (Heap k a) where
  <> :: Heap k a -> Heap k a -> Heap k a
(<>) = Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
append
#endif

-- |
--
-- Formed from 'empty' and 'append'
instance Ord k => Monoid (Heap k a) where
  mempty :: Heap k a
mempty = Heap k a
forall k a. Heap k a
empty

#if MIN_VERSION_base(4,11,0)
  -- starting with base-4.11, mappend definitions are redundant;
  -- at some point `mappend` will be removed from `Monoid`
#elif MIN_VERSION_base(4,9,0)
  mappend = (Sem.<>)
#else
  -- prior to GHC 8.0 / base-4.9 where no `Semigroup` class existed
  mappend = append
#endif

-- |
--
-- Prepend a key-value pair to the beginning of a 'Heap'.
--
-- /O(1)/.
--
-- >>> cons 'a' 0 fox
-- fromList [('a',0),('f',0),('o',1),('x',2)]
--
-- prop> toList (cons k v xs) == (k, v) : toList xs
cons :: Ord k => k -> a -> Heap k a -> Heap k a
cons :: forall k a. Ord k => k -> a -> Heap k a -> Heap k a
cons k
k a
v = (k -> a -> Heap k a
forall k a. k -> a -> Heap k a
singleton k
k a
v Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append`)

-- |
--
-- Append a key-value pair to the end of a 'Heap'.
--
-- /O(1)/.
--
-- >>> snoc fox 'y' 0
-- fromList [('f',0),('o',1),('x',2),('y',0)]
--
-- prop> toList (snoc xs k v) == toList xs ++ [(k, v)]
snoc :: Ord k => Heap k a -> k -> a -> Heap k a
snoc :: forall k a. Ord k => Heap k a -> k -> a -> Heap k a
snoc Heap k a
xs k
k a
v = Heap k a
xs Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` k -> a -> Heap k a
forall k a. k -> a -> Heap k a
singleton k
k a
v

-- |
--
-- Like 'foldr', but provides access to the key for each value in the folding
-- function.
--
-- >>> foldrWithKey (\k v kvs -> (k, v) : kvs) [] fox
-- [('f',0),('o',1),('x',2)]
--
-- prop> let f k v acc = g `apply` k `apply` v `apply` acc in foldrWithKey f z xs == foldr (uncurry f) z (toList xs)
foldrWithKey :: (k -> a -> b -> b) -> b -> Heap k a -> b
foldrWithKey :: forall k a b. (k -> a -> b -> b) -> b -> Heap k a -> b
foldrWithKey k -> a -> b -> b
f = (Heap k a -> b -> b) -> b -> Heap k a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Heap k a -> b -> b
go
  where
    go :: Heap k a -> b -> b
go Heap k a
Empty b
z = b
z
    go (Heap Int
_ Heap k a
l Heap k a
ls k
k a
v Heap k a
rs Heap k a
r) b
z = Heap k a -> b -> b
go Heap k a
l (Heap k a -> b -> b
go Heap k a
ls (k -> a -> b -> b
f k
k a
v (Heap k a -> b -> b
go Heap k a
rs (Heap k a -> b -> b
go Heap k a
r b
z))))

-- |
--
-- List the key-value pairs in a 'Heap' in sequence order. This is the semantic
-- function for 'Heap'.
--
-- >>> toList empty
-- []
--
-- >>> toList the
-- [('t',0),('h',1),('e',2)]
--
-- >>> toList quick
-- [('q',0),('u',1),('i',2),('c',3),('k',4)]
--
-- >>> toList brown
-- [('b',0),('r',1),('o',2),('w',3),('n',4)]
--
-- >>> toList fox
-- [('f',0),('o',1),('x',2)]
--
-- /O(n)/ when the spine of the result is evaluated fully.
--
-- prop> toList (fromList xs) == xs
-- prop> fromList (toList xs) == xs
toList :: Heap k a -> [(k, a)]
toList :: forall k a. Heap k a -> [(k, a)]
toList = (k -> a -> [(k, a)] -> [(k, a)])
-> [(k, a)] -> Heap k a -> [(k, a)]
forall k a b. (k -> a -> b -> b) -> b -> Heap k a -> b
foldrWithKey (\k
k a
v [(k, a)]
xs -> (k
k, a
v) (k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
: [(k, a)]
xs) []

-- |
--
-- List the key-value pairs in a 'Heap' in key order.
--
-- /O(n log n)/ when the spine of the result is evaluated fully.
--
-- >>> toAscList empty
-- []
--
-- >>> toAscList the
-- [('e',2),('h',1),('t',0)]
--
-- >>> toAscList quick
-- [('c',3),('i',2),('k',4),('q',0),('u',1)]
--
-- >>> toAscList brown
-- [('b',0),('n',4),('o',2),('r',1),('w',3)]
--
-- >>> toAscList fox
-- [('f',0),('o',1),('x',2)]
--
-- prop> toAscList xs == Data.List.sortOn fst (toList xs)
toAscList :: Ord k => Heap k a -> [(k, a)]
toAscList :: forall k a. Ord k => Heap k a -> [(k, a)]
toAscList = (Heap k a -> Maybe ((k, a), Heap k a)) -> Heap k a -> [(k, a)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Heap k a -> Maybe ((k, a), Heap k a)
forall {k} {a}. Ord k => Heap k a -> Maybe ((k, a), Heap k a)
f
  where
    f :: Heap k a -> Maybe ((k, a), Heap k a)
f Heap k a
xs =
      case Heap k a -> MinView k a
forall k a. Ord k => Heap k a -> MinView k a
minView Heap k a
xs of
        MinView k a
EmptyView -> Maybe ((k, a), Heap k a)
forall a. Maybe a
Nothing
        MinView Heap k a
l k
k a
v Heap k a
r -> ((k, a), Heap k a) -> Maybe ((k, a), Heap k a)
forall a. a -> Maybe a
Just ((k
k, a
v), Heap k a
l Heap k a -> Heap k a -> Heap k a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k a
r)

-- |
--
-- Construct a 'Heap' from a list of key-value pairs.
--
-- /O(n)/.
--
-- >>> fromList (zip [0..3] [4..])
-- fromList [(0,4),(1,5),(2,6),(3,7)]
--
-- prop> toList (fromList xs) == xs
-- prop> fromList (toList xs) == xs
fromList :: Ord k => [(k, a)] -> Heap k a
fromList :: forall k a. Ord k => [(k, a)] -> Heap k a
fromList = (Heap k a -> (k, a) -> Heap k a)
-> Heap k a -> [(k, a)] -> Heap k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Heap k a
acc (k
k, a
v) -> Heap k a -> k -> a -> Heap k a
forall k a. Ord k => Heap k a -> k -> a -> Heap k a
snoc Heap k a
acc k
k a
v) Heap k a
forall k a. Heap k a
empty

-- |
--
-- >>> bimap succ (*10) fox
-- fromList [('g',0),('p',10),('y',20)]
--
-- prop> toList (bimap (apply f) (apply g) xs) == map (\(k, v) -> (apply f k, apply g v)) (toList xs)
bimap :: Ord k2 => (k1 -> k2) -> (a -> b) -> Heap k1 a -> Heap k2 b
bimap :: forall k2 k1 a b.
Ord k2 =>
(k1 -> k2) -> (a -> b) -> Heap k1 a -> Heap k2 b
bimap k1 -> k2
f a -> b
g = Heap k1 a -> Heap k2 b
go
  where
    go :: Heap k1 a -> Heap k2 b
go Heap k1 a
Empty = Heap k2 b
forall k a. Heap k a
Empty
    go (Heap Int
_ Heap k1 a
l Heap k1 a
ls k1
k a
v Heap k1 a
rs Heap k1 a
r) =
      Heap k1 a -> Heap k2 b
go Heap k1 a
l Heap k2 b -> Heap k2 b -> Heap k2 b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k1 a -> Heap k2 b
go Heap k1 a
ls Heap k2 b -> Heap k2 b -> Heap k2 b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` k2 -> b -> Heap k2 b
forall k a. k -> a -> Heap k a
singleton (k1 -> k2
f k1
k) (a -> b
g a
v) Heap k2 b -> Heap k2 b -> Heap k2 b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k1 a -> Heap k2 b
go Heap k1 a
rs Heap k2 b -> Heap k2 b -> Heap k2 b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` Heap k1 a -> Heap k2 b
go Heap k1 a
r

-- |
--
-- >>> mapKeys succ fox
-- fromList [('g',0),('p',1),('y',2)]
--
-- prop> toList (mapKeys (apply f) xs) == map (\(k, v) -> (apply f k, v)) (toList xs)
mapKeys :: Ord k2 => (k1 -> k2) -> Heap k1 a -> Heap k2 a
mapKeys :: forall k2 k1 a. Ord k2 => (k1 -> k2) -> Heap k1 a -> Heap k2 a
mapKeys k1 -> k2
f = (k1 -> k2) -> (a -> a) -> Heap k1 a -> Heap k2 a
forall k2 k1 a b.
Ord k2 =>
(k1 -> k2) -> (a -> b) -> Heap k1 a -> Heap k2 b
bimap k1 -> k2
f a -> a
forall a. a -> a
id

-- |
--
-- Map a function over all values in a heap.
--
-- /O(1)/ when evaluating to WHNF. /O(n)/ when evaluating to NF.
--
-- >>> mapWithKey (\k v -> (k,v)) fox
-- fromList [('f',('f',0)),('o',('o',1)),('x',('x',2))]
--
-- prop> let f k v = g `apply` k `apply` v in mapWithKey f xs == fromList (map (\(k, v) -> (k, f k v)) (toList xs))
mapWithKey :: (k -> a -> b) -> Heap k a -> Heap k b
mapWithKey :: forall k a b. (k -> a -> b) -> Heap k a -> Heap k b
mapWithKey k -> a -> b
f = Heap k a -> Heap k b
go
  where
    go :: Heap k a -> Heap k b
go Heap k a
Empty = Heap k b
forall k a. Heap k a
Empty
    go (Heap Int
n Heap k a
l Heap k a
ls k
k a
v Heap k a
rs Heap k a
r) = Int
-> Heap k b
-> Heap k b
-> k
-> b
-> Heap k b
-> Heap k b
-> Heap k b
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap Int
n (Heap k a -> Heap k b
go Heap k a
l) (Heap k a -> Heap k b
go Heap k a
ls) k
k (k -> a -> b
f k
k a
v) (Heap k a -> Heap k b
go Heap k a
rs) (Heap k a -> Heap k b
go Heap k a
r)

-- |
--
-- Fold the keys and values in the heap using the given monoid, such that
--
-- /O(n)/.
--
-- >>> foldMapWithKey (\k v -> [(k,v)]) fox
-- [('f',0),('o',1),('x',2)]
--
-- prop> let f k v = g `apply` k `apply` v :: [Integer] in foldMapWithKey f xs == Data.Foldable.fold (mapWithKey f xs)
foldMapWithKey :: Monoid b => (k -> a -> b) -> Heap k a -> b
foldMapWithKey :: forall b k a. Monoid b => (k -> a -> b) -> Heap k a -> b
foldMapWithKey k -> a -> b
f = Heap k a -> b
go
  where
    go :: Heap k a -> b
go Heap k a
Empty = b
forall a. Monoid a => a
mempty
    go (Heap Int
_ Heap k a
l Heap k a
ls k
k a
v Heap k a
rs Heap k a
r) =
      Heap k a -> b
go Heap k a
l b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` Heap k a -> b
go Heap k a
ls b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` k -> a -> b
f k
k a
v b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` Heap k a -> b
go Heap k a
rs b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend` Heap k a -> b
go Heap k a
r

-- |
--
-- Behaves exactly like a regular traverse except that the traversing function
-- also has access to the key associated with a value, such that
--
-- /O(n)/.
--
-- >>> traverseWithKey (\k v -> print (k, v) >> return (succ k, v)) fox
-- ('f',0)
-- ('o',1)
-- ('x',2)
-- fromList [('f',('g',0)),('o',('p',1)),('x',('y',2))]
--
-- prop> let f k v = g `apply` k `apply` v :: ([Integer], Integer) in traverseWithKey f xs == (fromList <$> traverse (\(k, v) -> (,) k <$> f k v) (toList xs))

-- > traverseWithKey f = fromList . traverse ((k, v) -> (,) k $ f k v) . toList
traverseWithKey :: Applicative f => (k -> a -> f b) -> Heap k a -> f (Heap k b)
traverseWithKey :: forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> Heap k a -> f (Heap k b)
traverseWithKey k -> a -> f b
f = Heap k a -> f (Heap k b)
go
  where
    go :: Heap k a -> f (Heap k b)
go Heap k a
Empty = Heap k b -> f (Heap k b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Heap k b
forall k a. Heap k a
Empty
    go (Heap Int
n Heap k a
l Heap k a
ls k
k a
v Heap k a
rs Heap k a
r) = Int
-> Heap k b
-> Heap k b
-> k
-> b
-> Heap k b
-> Heap k b
-> Heap k b
forall k a.
Int
-> Heap k a
-> Heap k a
-> k
-> a
-> Heap k a
-> Heap k a
-> Heap k a
Heap Int
n (Heap k b
 -> Heap k b -> k -> b -> Heap k b -> Heap k b -> Heap k b)
-> f (Heap k b)
-> f (Heap k b -> k -> b -> Heap k b -> Heap k b -> Heap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Heap k a -> f (Heap k b)
go Heap k a
l f (Heap k b -> k -> b -> Heap k b -> Heap k b -> Heap k b)
-> f (Heap k b) -> f (k -> b -> Heap k b -> Heap k b -> Heap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Heap k a -> f (Heap k b)
go Heap k a
ls f (k -> b -> Heap k b -> Heap k b -> Heap k b)
-> f k -> f (b -> Heap k b -> Heap k b -> Heap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> f k
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure k
k f (b -> Heap k b -> Heap k b -> Heap k b)
-> f b -> f (Heap k b -> Heap k b -> Heap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> a -> f b
f k
k a
v f (Heap k b -> Heap k b -> Heap k b)
-> f (Heap k b) -> f (Heap k b -> Heap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Heap k a -> f (Heap k b)
go Heap k a
rs f (Heap k b -> Heap k b) -> f (Heap k b) -> f (Heap k b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Heap k a -> f (Heap k b)
go Heap k a
r

-- |
--
-- Behaves exactly like a regular traverse except that it's over the keys
-- instead of the values.
--
-- /O(n)/.
--
-- >>> traverseKeys (\k -> print k >> return (succ k)) fox
-- 'f'
-- 'o'
-- 'x'
-- fromList [('g',0),('p',1),('y',2)]
--
-- prop> traverseKeys (apply f) xs == (fromList <$> traverse (\(k, v) -> flip (,) v <$> (apply f k :: ([Integer], Integer))) (toList xs))
traverseKeys :: (Applicative f, Ord k2) => (k1 -> f k2) -> Heap k1 a -> f (Heap k2 a)
traverseKeys :: forall (f :: * -> *) k2 k1 a.
(Applicative f, Ord k2) =>
(k1 -> f k2) -> Heap k1 a -> f (Heap k2 a)
traverseKeys k1 -> f k2
f = Heap k1 a -> f (Heap k2 a)
go
  where
    go :: Heap k1 a -> f (Heap k2 a)
go Heap k1 a
Empty = Heap k2 a -> f (Heap k2 a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Heap k2 a
forall k a. Heap k a
Empty
    go (Heap Int
_ Heap k1 a
l Heap k1 a
ls k1
k a
v Heap k1 a
rs Heap k1 a
r) = Heap k1 a -> f (Heap k2 a)
go Heap k1 a
l f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
forall {a}. f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
<.> Heap k1 a -> f (Heap k2 a)
go Heap k1 a
ls f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
forall {a}. f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
<.> ((k2 -> a -> Heap k2 a
forall k a. k -> a -> Heap k a
`singleton` a
v) (k2 -> Heap k2 a) -> f k2 -> f (Heap k2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k1 -> f k2
f k1
k) f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
forall {a}. f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
<.> Heap k1 a -> f (Heap k2 a)
go Heap k1 a
rs f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
forall {a}. f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
<.> Heap k1 a -> f (Heap k2 a)
go Heap k1 a
r
    <.> :: f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
(<.>) = (Heap k2 a -> Heap k2 a -> Heap k2 a)
-> f (Heap k2 a) -> f (Heap k2 a) -> f (Heap k2 a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Heap k2 a -> Heap k2 a -> Heap k2 a
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
append

-- |
--
-- Equivalent to @WriterT k []@
instance (Monoid k, Ord k) => Applicative (Heap k) where
  pure :: forall a. a -> Heap k a
pure = k -> a -> Heap k a
forall k a. k -> a -> Heap k a
singleton k
forall a. Monoid a => a
mempty
  Heap k (a -> b)
Empty <*> :: forall a b. Heap k (a -> b) -> Heap k a -> Heap k b
<*> Heap k a
_ = Heap k b
forall k a. Heap k a
Empty
  Heap k (a -> b)
_ <*> Heap k a
Empty = Heap k b
forall k a. Heap k a
Empty
  Heap Int
_ Heap k (a -> b)
fl Heap k (a -> b)
fls k
fk a -> b
f Heap k (a -> b)
frs Heap k (a -> b)
fr <*> Heap k a
xs
    =  (Heap k (a -> b)
fl  Heap k (a -> b) -> Heap k a -> Heap k b
forall a b. Heap k (a -> b) -> Heap k a -> Heap k b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>         Heap k a
xs)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k (a -> b)
fls Heap k (a -> b) -> Heap k a -> Heap k b
forall a b. Heap k (a -> b) -> Heap k a -> Heap k b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Heap k a
xs)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (k -> k) -> (a -> b) -> Heap k a -> Heap k b
forall k2 k1 a b.
Ord k2 =>
(k1 -> k2) -> (a -> b) -> Heap k1 a -> Heap k2 b
bimap (k
fk k -> k -> k
forall a. Monoid a => a -> a -> a
`mappend`) a -> b
f Heap k a
xs
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k (a -> b)
frs Heap k (a -> b) -> Heap k a -> Heap k b
forall a b. Heap k (a -> b) -> Heap k a -> Heap k b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Heap k a
xs)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k (a -> b)
fr  Heap k (a -> b) -> Heap k a -> Heap k b
forall a b. Heap k (a -> b) -> Heap k a -> Heap k b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Heap k a
xs)

-- |
--
-- Equivalent to @WriterT k []@
instance (Monoid k, Ord k) => Monad (Heap k) where
  return :: forall a. a -> Heap k a
return = a -> Heap k a
forall a. a -> Heap k a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Heap k a
Empty >>= :: forall a b. Heap k a -> (a -> Heap k b) -> Heap k b
>>= a -> Heap k b
_ = Heap k b
forall k a. Heap k a
Empty
  Heap Int
_ Heap k a
xl Heap k a
xls k
xk a
x Heap k a
xrs Heap k a
xr >>= a -> Heap k b
f
    =  (Heap k a
xl  Heap k a -> (a -> Heap k b) -> Heap k b
forall a b. Heap k a -> (a -> Heap k b) -> Heap k b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Heap k b
f)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k a
xls Heap k a -> (a -> Heap k b) -> Heap k b
forall a b. Heap k a -> (a -> Heap k b) -> Heap k b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Heap k b
f)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (k -> k) -> Heap k b -> Heap k b
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Heap k1 a -> Heap k2 a
mapKeys (k
xk k -> k -> k
forall a. Monoid a => a -> a -> a
`mappend`) (a -> Heap k b
f a
x)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k a
xrs Heap k a -> (a -> Heap k b) -> Heap k b
forall a b. Heap k a -> (a -> Heap k b) -> Heap k b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Heap k b
f)
    Heap k b -> Heap k b -> Heap k b
forall k a. Ord k => Heap k a -> Heap k a -> Heap k a
`append` (Heap k a
xr  Heap k a -> (a -> Heap k b) -> Heap k b
forall a b. Heap k a -> (a -> Heap k b) -> Heap k b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Heap k b
f)

instance (Show k, Show a) => Show (Heap k a) where
  showsPrec :: Int -> Heap k a -> ShowS
showsPrec Int
d Heap k a
h = 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
. [(k, a)] -> ShowS
forall a. Show a => a -> ShowS
shows (Heap k a -> [(k, a)]
forall k a. Heap k a -> [(k, a)]
toList Heap k a
h)

instance (Ord k, Read k, Read a) => Read (Heap k a) where
  readsPrec :: Int -> ReadS (Heap k a)
readsPrec Int
p = Bool -> ReadS (Heap k a) -> ReadS (Heap k a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Heap k a) -> ReadS (Heap k a))
-> ReadS (Heap k a) -> ReadS (Heap k a)
forall a b. (a -> b) -> a -> b
$ \ String
r -> do
    (String
"fromList", String
s) <- ReadS String
lex String
r
    ([(k, a)]
xs, String
t) <- ReadS [(k, a)]
forall a. Read a => ReadS a
reads String
s
    (Heap k a, String) -> [(Heap k a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(k, a)] -> Heap k a
forall k a. Ord k => [(k, a)] -> Heap k a
fromList [(k, a)]
xs, String
t)

instance Ord k => GHC.Exts.IsList (Heap k a) where
  type Item (Heap k a) = (k, a)
  fromList :: [Item (Heap k a)] -> Heap k a
fromList = [(k, a)] -> Heap k a
[Item (Heap k a)] -> Heap k a
forall k a. Ord k => [(k, a)] -> Heap k a
fromList
  toList :: Heap k a -> [Item (Heap k a)]
toList   = Heap k a -> [(k, a)]
Heap k a -> [Item (Heap k a)]
forall k a. Heap k a -> [(k, a)]
toList

-- |
--
-- prop> (xs == ys) == (toList xs == toList ys)
instance (Eq k, Eq a) => Eq (Heap k a) where
  Heap k a
xs == :: Heap k a -> Heap k a -> Bool
== Heap k a
ys = Heap k a -> [(k, a)]
forall k a. Heap k a -> [(k, a)]
toList Heap k a
xs [(k, a)] -> [(k, a)] -> Bool
forall a. Eq a => a -> a -> Bool
== Heap k a -> [(k, a)]
forall k a. Heap k a -> [(k, a)]
toList Heap k a
ys

-- |
--
-- prop> compare xs ys == compare (toList xs) (toList ys)
instance (Ord k, Ord a) => Ord (Heap k a) where
  compare :: Heap k a -> Heap k a -> Ordering
compare Heap k a
xs Heap k a
ys = [(k, a)] -> [(k, a)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Heap k a -> [(k, a)]
forall k a. Heap k a -> [(k, a)]
toList Heap k a
xs) (Heap k a -> [(k, a)]
forall k a. Heap k a -> [(k, a)]
toList Heap k a
ys)

-- |
--
-- Formed from 'empty' and 'append'
instance (Monoid k, Ord k) => Applicative.Alternative (Heap k) where
  empty :: forall a. Heap k a
empty = Heap k a
forall a. Monoid a => a
mempty
  <|> :: forall a. Heap k a -> Heap k a -> Heap k a
(<|>) = Heap k a -> Heap k a -> Heap k a
forall a. Monoid a => a -> a -> a
mappend

-- |
--
-- Formed from 'empty' and 'append'
instance (Monoid k, Ord k) => MonadPlus (Heap k) where
  mzero :: forall a. Heap k a
mzero = Heap k a
forall a. Monoid a => a
mempty
  mplus :: forall a. Heap k a -> Heap k a -> Heap k a
mplus = Heap k a -> Heap k a -> Heap k a
forall a. Monoid a => a -> a -> a
mappend

-- $setup
--
-- We use QuickCheck to verify the properties given in this documentation. Here
-- is the necessary setup code:
--
-- >>> import Test.QuickCheck
-- >>> import Test.QuickCheck.Function
-- >>> :{
-- instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (Heap k v) where
--   arbitrary = fromList <$> arbitrary
--   shrink = map fromList . shrink . toList
-- :}
--
-- Here are some example values used in the documentation for this module:
--
-- >>> let the   = fromList (zip "the"   [0..])
-- >>> let quick = fromList (zip "quick" [0..])
-- >>> let brown = fromList (zip "brown" [0..])
-- >>> let fox   = fromList (zip "fox"   [0..])
--
-- >>> the
-- fromList [('t',0),('h',1),('e',2)]
--
-- >>> quick
-- fromList [('q',0),('u',1),('i',2),('c',3),('k',4)]
--
-- >>> brown
-- fromList [('b',0),('r',1),('o',2),('w',3),('n',4)]
--
-- >>> fox
-- fromList [('f',0),('o',1),('x',2)]