{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}

module Data.PQueue.Internals (
  MinQueue (..),
  BinomHeap,
  BinomForest(..),
  BinomTree(..),
  Succ(..),
  Zero(..),
  LEq,
  empty,
  null,
  size,
  getMin,
  minView,
  singleton,
  insert,
  union,
  mapMaybe,
  mapEither,
  mapMonotonic,
  foldrAsc,
  foldlAsc,
  foldrDesc,
  insertMinQ,
  insertMinQ',
  insertMaxQ',
  toAscList,
  toDescList,
  toListU,
  fromList,
  mapU,
  fromAscList,
  foldMapU,
  foldrU,
  foldlU,
  foldlU',
--   traverseU,
  seqSpine,
  unions
  ) where

import BinomialQueue.Internals
  ( BinomHeap
  , BinomForest (..)
  , BinomTree (..)
  , Succ (..)
  , Zero (..)
  , Extract (..)
  , MExtract (..)
  )
import qualified BinomialQueue.Internals as BQ
import Control.DeepSeq (NFData(rnf), deepseq)
import Data.Foldable (foldl')
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..), stimesMonoid)
#endif

import Data.PQueue.Internals.Foldable
#ifdef __GLASGOW_HASKELL__
import Data.Data
import Text.Read (Lexeme(Ident), lexP, parens, prec,
  readPrec, readListPrec, readListPrecDefault)
import GHC.Exts (build)
#endif

import Prelude hiding (null)

#ifndef __GLASGOW_HASKELL__
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif

-- | A priority queue with elements of type @a@. Supports extracting the minimum element.
data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int !a !(BQ.MinQueue a)

fromBare :: Ord a => BQ.MinQueue a -> MinQueue a
-- Should we fuse the size calculation with the minimum extraction?
fromBare :: MinQueue a -> MinQueue a
fromBare MinQueue a
xs = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
BQ.minView MinQueue a
xs of
  Just (a
x, MinQueue a
xs') -> Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MinQueue a -> Int
forall a. MinQueue a -> Int
BQ.size MinQueue a
xs') a
x MinQueue a
xs'
  Maybe (a, MinQueue a)
Nothing -> MinQueue a
forall a. MinQueue a
Empty

#ifdef __GLASGOW_HASKELL__
instance (Ord a, Data a) => Data (MinQueue a) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MinQueue a -> c (MinQueue a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z MinQueue a
q = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
q of
    Maybe (a, MinQueue a)
Nothing      -> MinQueue a -> c (MinQueue a)
forall g. g -> c g
z MinQueue a
forall a. MinQueue a
Empty
    Just (a
x, MinQueue a
q') -> (a -> MinQueue a -> MinQueue a)
-> c (a -> MinQueue a -> MinQueue a)
forall g. g -> c g
z a -> MinQueue a -> MinQueue a
forall a. Ord a => a -> MinQueue a -> MinQueue a
insert c (a -> MinQueue a -> MinQueue a)
-> a -> c (MinQueue a -> MinQueue a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x c (MinQueue a -> MinQueue a) -> MinQueue a -> c (MinQueue a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` MinQueue a
q'

  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MinQueue 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 -> MinQueue a -> c (MinQueue a)
forall r. r -> c r
z MinQueue a
forall a. MinQueue a
Empty
    Int
2 -> c (MinQueue a -> MinQueue a) -> c (MinQueue a)
forall b r. Data b => c (b -> r) -> c r
k (c (a -> MinQueue a -> MinQueue a) -> c (MinQueue a -> MinQueue a)
forall b r. Data b => c (b -> r) -> c r
k ((a -> MinQueue a -> MinQueue a)
-> c (a -> MinQueue a -> MinQueue a)
forall r. r -> c r
z a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMinQ))
    Int
_ -> [Char] -> c (MinQueue a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (MinQueue a))
dataCast1 forall d. Data d => c (t d)
x = c (t a) -> Maybe (c (MinQueue a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
x

  toConstr :: MinQueue a -> Constr
toConstr MinQueue a
q
    | MinQueue a -> Bool
forall a. MinQueue a -> Bool
null MinQueue a
q = Constr
emptyConstr
    | Bool
otherwise = Constr
consConstr

  dataTypeOf :: MinQueue a -> DataType
dataTypeOf MinQueue a
_ = DataType
queueDataType

queueDataType :: DataType
queueDataType :: DataType
queueDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.PQueue.Min.MinQueue" [Constr
emptyConstr, Constr
consConstr]

emptyConstr, consConstr :: Constr
emptyConstr :: Constr
emptyConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
queueDataType [Char]
"empty" [] Fixity
Prefix
consConstr :: Constr
consConstr  = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
queueDataType [Char]
"<|" [] Fixity
Infix

#endif

instance Ord a => Eq (MinQueue a) where
  MinQueue a
Empty == :: MinQueue a -> MinQueue a -> Bool
== MinQueue a
Empty = Bool
True
  MinQueue Int
n1 a
x1 MinQueue a
q1 == MinQueue Int
n2 a
x2 MinQueue a
q2 =
    Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& MinQueue a
q1 MinQueue a -> MinQueue a -> Bool
forall a. Eq a => a -> a -> Bool
== MinQueue a
q2
  MinQueue a
_ == MinQueue a
_ = Bool
False

instance Ord a => Ord (MinQueue a) where
  MinQueue a
Empty compare :: MinQueue a -> MinQueue a -> Ordering
`compare` MinQueue a
Empty = Ordering
EQ
  MinQueue a
Empty `compare` MinQueue a
_ = Ordering
LT
  MinQueue a
_ `compare` MinQueue a
Empty = Ordering
GT
  MinQueue Int
_n1 a
x1 MinQueue a
q1 `compare` MinQueue Int
_n2 a
x2 MinQueue a
q2 = (a, MinQueue a) -> (a, MinQueue a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a
x1,MinQueue a
q1) (a
x2,MinQueue a
q2)

    -- We compare their first elements, then their other elements up to the smaller queue's length,
    -- and then the longer queue wins.
    -- This is equivalent to @comparing toAscList@, except it fuses much more nicely.

-- | Type alias for a comparison function.
type LEq a = a -> a -> Bool

-- basics

-- | \(O(1)\). The empty priority queue.
empty :: MinQueue a
empty :: MinQueue a
empty = MinQueue a
forall a. MinQueue a
Empty

-- | \(O(1)\). Is this the empty priority queue?
null :: MinQueue a -> Bool
null :: MinQueue a -> Bool
null MinQueue a
Empty = Bool
True
null MinQueue a
_     = Bool
False

-- | \(O(1)\). The number of elements in the queue.
size :: MinQueue a -> Int
size :: MinQueue a -> Int
size MinQueue a
Empty            = Int
0
size (MinQueue Int
n a
_ MinQueue a
_) = Int
n

-- | \(O(1)\). Returns the minimum element of the queue, if the queue is nonempty.
getMin :: MinQueue a -> Maybe a
getMin :: MinQueue a -> Maybe a
getMin (MinQueue Int
_ a
x MinQueue a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
getMin MinQueue a
_                = Maybe a
forall a. Maybe a
Nothing

-- | Retrieves the minimum element of the queue, and the queue stripped of that element,
-- or 'Nothing' if passed an empty queue.
minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView :: MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
Empty = Maybe (a, MinQueue a)
forall a. Maybe a
Nothing
minView (MinQueue Int
n a
x MinQueue a
ts) = (a, MinQueue a) -> Maybe (a, MinQueue a)
forall a. a -> Maybe a
Just (a
x, case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
BQ.minView MinQueue a
ts of
  Maybe (a, MinQueue a)
Nothing        -> MinQueue a
forall a. MinQueue a
Empty
  Just (a
x', MinQueue a
ts') -> Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
x' MinQueue a
ts')

-- | \(O(1)\). Construct a priority queue with a single element.
singleton :: a -> MinQueue a
singleton :: a -> MinQueue a
singleton a
x = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue Int
1 a
x MinQueue a
forall a. MinQueue a
BQ.empty

-- | Amortized \(O(1)\), worst-case \(O(\log n)\). Insert an element into the priority queue.
insert :: Ord a => a -> MinQueue a -> MinQueue a
insert :: a -> MinQueue a -> MinQueue a
insert = LEq a -> a -> MinQueue a -> MinQueue a
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
forall a. Ord a => a -> a -> Bool
(<=)

-- | Amortized \(O(\log \min(n,m))\), worst-case \(O(\log \max(n,m))\). Take the union of two priority queues.
union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
union :: MinQueue a -> MinQueue a -> MinQueue a
union = LEq a -> MinQueue a -> MinQueue a -> MinQueue a
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq a
forall a. Ord a => a -> a -> Bool
(<=)

-- | Takes the union of a list of priority queues. Equivalent to @'foldl'' 'union' 'empty'@.
unions :: Ord a => [MinQueue a] -> MinQueue a
unions :: [MinQueue a] -> MinQueue a
unions = (MinQueue a -> MinQueue a -> MinQueue a)
-> MinQueue a -> [MinQueue a] -> MinQueue a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MinQueue a -> MinQueue a -> MinQueue a
forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union MinQueue a
forall a. MinQueue a
empty

-- | \(O(n)\). Map elements and collect the 'Just' results.
mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe :: (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe a -> Maybe b
_ MinQueue a
Empty = MinQueue b
forall a. MinQueue a
Empty
mapMaybe a -> Maybe b
f (MinQueue Int
_ a
x MinQueue a
ts) = MinQueue b -> MinQueue b
forall a. Ord a => MinQueue a -> MinQueue a
fromBare (MinQueue b -> MinQueue b) -> MinQueue b -> MinQueue b
forall a b. (a -> b) -> a -> b
$ MinQueue b -> (b -> MinQueue b) -> Maybe b -> MinQueue b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MinQueue b
q' (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
`BQ.insert` MinQueue b
q') (a -> Maybe b
f a
x)
  where
    q' :: MinQueue b
q' = (a -> Maybe b) -> MinQueue a -> MinQueue b
forall b a. Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
BQ.mapMaybe a -> Maybe b
f MinQueue a
ts

-- | \(O(n)\). Map elements and separate the 'Left' and 'Right' results.
mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither :: (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither a -> Either b c
_ MinQueue a
Empty = (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty)
mapEither a -> Either b c
f (MinQueue Int
_ a
x MinQueue a
ts)
  | (MinQueue b
l, MinQueue c
r) <- (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
forall b c a.
(Ord b, Ord c) =>
(a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
BQ.mapEither a -> Either b c
f MinQueue a
ts
  = case a -> Either b c
f a
x of
      Left b
y -> (MinQueue b -> MinQueue b
forall a. Ord a => MinQueue a -> MinQueue a
fromBare (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
BQ.insert b
y MinQueue b
l), MinQueue c -> MinQueue c
forall a. Ord a => MinQueue a -> MinQueue a
fromBare MinQueue c
r)
      Right c
z -> (MinQueue b -> MinQueue b
forall a. Ord a => MinQueue a -> MinQueue a
fromBare MinQueue b
l, MinQueue c -> MinQueue c
forall a. Ord a => MinQueue a -> MinQueue a
fromBare (c -> MinQueue c -> MinQueue c
forall a. Ord a => a -> MinQueue a -> MinQueue a
BQ.insert c
z MinQueue c
r))

-- | \(O(n)\). Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
-- as in 'fmap'. If it is not, the result is undefined.
mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic = (a -> b) -> MinQueue a -> MinQueue b
forall a b. (a -> b) -> MinQueue a -> MinQueue b
mapU

{-# INLINABLE [0] foldrAsc #-}
-- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in
-- ascending order.
foldrAsc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc :: (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc a -> b -> b
_ b
z MinQueue a
Empty = b
z
foldrAsc a -> b -> b
f b
z (MinQueue Int
_ a
x MinQueue a
ts) = a
x a -> b -> b
`f` (a -> b -> b)
-> b -> (MinQueue a -> Maybe (a, MinQueue a)) -> MinQueue a -> b
forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
BQ.foldrUnfold a -> b -> b
f b
z MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
BQ.minView MinQueue a
ts

-- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in descending order.
-- @foldrDesc f z q == foldlAsc (flip f) z q@.
foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc :: (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc = (b -> a -> b) -> b -> MinQueue a -> b
forall a b. Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc ((b -> a -> b) -> b -> MinQueue a -> b)
-> ((a -> b -> b) -> b -> a -> b)
-> (a -> b -> b)
-> b
-> MinQueue a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE [0] foldrDesc #-}

-- | \(O(n \log n)\). Performs a left fold on the elements of a priority queue in
-- ascending order.
foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc :: (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc b -> a -> b
_ b
z MinQueue a
Empty             = b
z
foldlAsc b -> a -> b
f b
z (MinQueue Int
_ a
x MinQueue a
ts) = (b -> a -> b)
-> b -> (MinQueue a -> Maybe (a, MinQueue a)) -> MinQueue a -> b
forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
BQ.foldlUnfold b -> a -> b
f (b
z b -> a -> b
`f` a
x) MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
BQ.minView MinQueue a
ts

{-# INLINABLE [1] toAscList #-}
-- | \(O(n \log n)\). Extracts the elements of the priority queue in ascending order.
toAscList :: Ord a => MinQueue a -> [a]
toAscList :: MinQueue a -> [a]
toAscList MinQueue a
queue = (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc (:) [] MinQueue a
queue

{-# INLINABLE toAscListApp #-}
toAscListApp :: Ord a => MinQueue a -> [a] -> [a]
toAscListApp :: MinQueue a -> [a] -> [a]
toAscListApp MinQueue a
Empty [a]
app = [a]
app
toAscListApp (MinQueue Int
_ a
x MinQueue a
ts) [a]
app = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a] -> [a])
-> [a]
-> (MinQueue a -> Maybe (a, MinQueue a))
-> MinQueue a
-> [a]
forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
BQ.foldrUnfold (:) [a]
app MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
BQ.minView MinQueue a
ts

{-# INLINABLE [1] toDescList #-}
-- | \(O(n \log n)\). Extracts the elements of the priority queue in descending order.
toDescList :: Ord a => MinQueue a -> [a]
toDescList :: MinQueue a -> [a]
toDescList MinQueue a
queue = (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc (:) [] MinQueue a
queue

{-# INLINABLE toDescListApp #-}
toDescListApp :: Ord a => MinQueue a -> [a] -> [a]
toDescListApp :: MinQueue a -> [a] -> [a]
toDescListApp MinQueue a
Empty [a]
app = [a]
app
toDescListApp (MinQueue Int
_ a
x MinQueue a
ts) [a]
app = ([a] -> a -> [a])
-> [a]
-> (MinQueue a -> Maybe (a, MinQueue a))
-> MinQueue a
-> [a]
forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
BQ.foldlUnfold ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
app) MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
BQ.minView MinQueue a
ts

{-# RULES
"toAscList" [~1] forall q. toAscList q = build (\c nil -> foldrAsc c nil q)
"toDescList" [~1] forall q. toDescList q = build (\c nil -> foldrDesc c nil q)
"ascList" [1] forall q add. foldrAsc (:) add q = toAscListApp q add
"descList" [1] forall q add. foldrDesc (:) add q = toDescListApp q add
 #-}

{-# INLINE fromAscList #-}
-- | \(O(n)\). Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.
--
-- Performance note: Code using this function in a performance-sensitive context
-- with an argument that is a "good producer" for list fusion should be compiled
-- with @-fspec-constr@ or @-O2@. For example, @fromAscList . map f@ needs one
-- of these options for best results.
fromAscList :: [a] -> MinQueue a
-- We apply an explicit argument to get foldl' to inline.
fromAscList :: [a] -> MinQueue a
fromAscList [a]
xs = (MinQueue a -> a -> MinQueue a) -> MinQueue a -> [a] -> MinQueue a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> MinQueue a -> MinQueue a) -> MinQueue a -> a -> MinQueue a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMaxQ') MinQueue a
forall a. MinQueue a
empty [a]
xs

insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
_ a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insert' LEq a
le a
x (MinQueue Int
n a
x' MinQueue a
ts)
  | a
x LEq a
`le` a
x' = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
BQ.insertMinQ a
x' MinQueue a
ts)
  | Bool
otherwise = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x' (LEq a -> a -> MinQueue a -> MinQueue a
forall a. LEq a -> a -> MinQueue a -> MinQueue a
BQ.insert' LEq a
le a
x MinQueue a
ts)

{-# INLINE union' #-}
union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq a
_ MinQueue a
Empty MinQueue a
q = MinQueue a
q
union' LEq a
_ MinQueue a
q MinQueue a
Empty = MinQueue a
q
union' LEq a
le (MinQueue Int
n1 a
x1 MinQueue a
f1) (MinQueue Int
n2 a
x2 MinQueue a
f2)
  | a
x1 LEq a
`le` a
x2 = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) a
x1 (LEq a -> a -> MinQueue a -> MinQueue a -> MinQueue a
forall a. LEq a -> a -> MinQueue a -> MinQueue a -> MinQueue a
BQ.unionPlusOne LEq a
le a
x2 MinQueue a
f1 MinQueue a
f2)
  | Bool
otherwise  = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) a
x2 (LEq a -> a -> MinQueue a -> MinQueue a -> MinQueue a
forall a. LEq a -> a -> MinQueue a -> MinQueue a -> MinQueue a
BQ.unionPlusOne LEq a
le a
x1 MinQueue a
f1 MinQueue a
f2)

-- | @insertMinQ x h@ assumes that @x@ compares as less
-- than or equal to every element of @h@.
insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insertMinQ a
x (MinQueue Int
n a
x' MinQueue a
f) = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
BQ.insertMinQ a
x' MinQueue a
f)

-- | @insertMinQ' x h@ assumes that @x@ compares as less
-- than or equal to every element of @h@.
insertMinQ' :: a -> MinQueue a -> MinQueue a
insertMinQ' :: a -> MinQueue a -> MinQueue a
insertMinQ' a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insertMinQ' a
x (MinQueue Int
n a
x' MinQueue a
f) = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
BQ.insertMinQ' a
x' MinQueue a
f)

-- | @insertMaxQ' x h@ assumes that @x@ compares as greater
-- than or equal to every element of @h@. It also assumes,
-- and preserves, an extra invariant. See 'insertMax'' for details.
-- tldr: this function can be used safely to build a queue from an
-- ascending list/array/whatever, but that's about it.
insertMaxQ' :: a -> MinQueue a -> MinQueue a
insertMaxQ' :: a -> MinQueue a -> MinQueue a
insertMaxQ' a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insertMaxQ' a
x (MinQueue Int
n a
x' MinQueue a
f) = Int -> a -> MinQueue a -> MinQueue a
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x' (a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
BQ.insertMaxQ' a
x MinQueue a
f)

{-# INLINABLE fromList #-}
-- | \(O(n)\). Constructs a priority queue from an unordered list.
fromList :: Ord a => [a] -> MinQueue a
-- We build a forest first and then extract its minimum at the end.
-- Why not just build the 'MinQueue' directly? This way saves us one
-- comparison per element.
fromList :: [a] -> MinQueue a
fromList [a]
xs = MinQueue a -> MinQueue a
forall a. Ord a => MinQueue a -> MinQueue a
fromBare ([a] -> MinQueue a
forall a. Ord a => [a] -> MinQueue a
BQ.fromList [a]
xs)

mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU a -> b
_ MinQueue a
Empty = MinQueue b
forall a. MinQueue a
Empty
mapU a -> b
f (MinQueue Int
n a
x MinQueue a
ts) = Int -> b -> MinQueue b -> MinQueue b
forall a. Int -> a -> MinQueue a -> MinQueue a
MinQueue Int
n (a -> b
f a
x) ((a -> b) -> MinQueue a -> MinQueue b
forall a b. (a -> b) -> MinQueue a -> MinQueue b
BQ.mapU a -> b
f MinQueue a
ts)

{-# NOINLINE [0] foldrU #-}
-- | \(O(n)\). Unordered right fold on a priority queue.
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU a -> b -> b
_ b
z MinQueue a
Empty = b
z
foldrU a -> b -> b
f b
z (MinQueue Int
_ a
x MinQueue a
ts) = a
x a -> b -> b
`f` (a -> b -> b) -> b -> MinQueue a -> b
forall a b. (a -> b -> b) -> b -> MinQueue a -> b
BQ.foldrU a -> b -> b
f b
z MinQueue a
ts

-- | \(O(n)\). Unordered left fold on a priority queue. This is rarely
-- what you want; 'foldrU' and 'foldlU'' are more likely to perform
-- well.
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU b -> a -> b
_ b
z MinQueue a
Empty = b
z
foldlU b -> a -> b
f b
z (MinQueue Int
_ a
x MinQueue a
ts) = (b -> a -> b) -> b -> MinQueue a -> b
forall b a. (b -> a -> b) -> b -> MinQueue a -> b
BQ.foldlU b -> a -> b
f (b
z b -> a -> b
`f` a
x) MinQueue a
ts

-- | \(O(n)\). Unordered strict left fold on a priority queue.
--
-- @since 1.4.2
foldlU' :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU' :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU' b -> a -> b
_ b
z MinQueue a
Empty = b
z
foldlU' b -> a -> b
f b
z (MinQueue Int
_ a
x MinQueue a
ts) = (b -> a -> b) -> b -> MinQueue a -> b
forall b a. (b -> a -> b) -> b -> MinQueue a -> b
BQ.foldlU' b -> a -> b
f (b
z b -> a -> b
`f` a
x) MinQueue a
ts

-- | \(O(n)\). Unordered monoidal fold on a priority queue.
--
-- @since 1.4.2
foldMapU :: Monoid m => (a -> m) -> MinQueue a -> m
foldMapU :: (a -> m) -> MinQueue a -> m
foldMapU a -> m
_ MinQueue a
Empty = m
forall a. Monoid a => a
mempty
foldMapU a -> m
f (MinQueue Int
_ a
x MinQueue a
ts) = a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> MinQueue a -> m
forall m a. Monoid m => (a -> m) -> MinQueue a -> m
BQ.foldMapU a -> m
f MinQueue a
ts

{-# NOINLINE toListU #-}
-- | \(O(n)\). Returns the elements of the queue, in no particular order.
toListU :: MinQueue a -> [a]
toListU :: MinQueue a -> [a]
toListU MinQueue a
q = (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
forall a b. (a -> b -> b) -> b -> MinQueue a -> b
foldrU (:) [] MinQueue a
q

{-# NOINLINE toListUApp #-}
toListUApp :: MinQueue a -> [a] -> [a]
toListUApp :: MinQueue a -> [a] -> [a]
toListUApp MinQueue a
Empty [a]
app = [a]
app
toListUApp (MinQueue Int
_ a
x MinQueue a
ts) [a]
app = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
forall a b. (a -> b -> b) -> b -> MinQueue a -> b
BQ.foldrU (:) [a]
app MinQueue a
ts

{-# RULES
"toListU/build" [~1] forall q. toListU q = build (\c n -> foldrU c n q)
"toListU" [1] forall q app. foldrU (:) app q = toListUApp q app
  #-}

-- traverseU :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b)
-- traverseU _ Empty = pure Empty
-- traverseU f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts

-- | \(O(\log n)\). @seqSpine q r@ forces the spine of @q@ and returns @r@.
--
-- Note: The spine of a 'MinQueue' is stored somewhat lazily. Most operations
-- take great care to prevent chains of thunks from accumulating along the
-- spine to the detriment of performance. However, @mapU@ can leave expensive
-- thunks in the structure and repeated applications of that function can
-- create thunk chains.
seqSpine :: MinQueue a -> b -> b
seqSpine :: MinQueue a -> b -> b
seqSpine MinQueue a
Empty b
z = b
z
seqSpine (MinQueue Int
_ a
_ MinQueue a
ts) b
z = MinQueue a -> b -> b
forall a b. MinQueue a -> b -> b
BQ.seqSpine MinQueue a
ts b
z

instance NFData a => NFData (MinQueue a) where
  rnf :: MinQueue a -> ()
rnf MinQueue a
Empty             = ()
  rnf (MinQueue Int
_ a
x MinQueue a
ts) = a
x a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` MinQueue a -> ()
forall a. NFData a => a -> ()
rnf MinQueue a
ts

instance (Ord a, Show a) => Show (MinQueue a) where
  showsPrec :: Int -> MinQueue a -> ShowS
showsPrec Int
p MinQueue a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromAscList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (MinQueue a -> [a]
forall a. Ord a => MinQueue a -> [a]
toAscList MinQueue a
xs)

instance Read a => Read (MinQueue a) where
#ifdef __GLASGOW_HASKELL__
  readPrec :: ReadPrec (MinQueue a)
readPrec = ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (MinQueue a) -> ReadPrec (MinQueue a))
-> ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (MinQueue a) -> ReadPrec (MinQueue a))
-> ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromAscList" <- ReadPrec Lexeme
lexP
    [a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
    MinQueue a -> ReadPrec (MinQueue a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> MinQueue a
forall a. [a] -> MinQueue a
fromAscList [a]
xs)

  readListPrec :: ReadPrec [MinQueue a]
readListPrec = ReadPrec [MinQueue a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
  readsPrec p = readParen (p > 10) $ \r -> do
    ("fromAscList",s) <- lex r
    (xs,t) <- reads s
    return (fromAscList xs,t)
#endif

#if MIN_VERSION_base(4,9,0)
instance Ord a => Semigroup (MinQueue a) where
  <> :: MinQueue a -> MinQueue a -> MinQueue a
(<>) = MinQueue a -> MinQueue a -> MinQueue a
forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union
  stimes :: b -> MinQueue a -> MinQueue a
stimes = b -> MinQueue a -> MinQueue a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
#endif

instance Ord a => Monoid (MinQueue a) where
  mempty :: MinQueue a
mempty = MinQueue a
forall a. MinQueue a
empty
#if !MIN_VERSION_base(4,11,0)
  mappend = union
#endif
  mconcat :: [MinQueue a] -> MinQueue a
mconcat = [MinQueue a] -> MinQueue a
forall a. Ord a => [MinQueue a] -> MinQueue a
unions