{-# LANGUAGE BangPatterns #-}

{-# OPTIONS_HADDOCK not-home #-}

-- |
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- This module provides the various sorting implementations for
-- "Data.Sequence". Further notes are available in the file sorting.md
-- (in this directory).

module Data.Sequence.Internal.Sorting
  (
   -- * Sort Functions
   sort
  ,sortBy
  ,sortOn
  ,unstableSort
  ,unstableSortBy
  ,unstableSortOn
  ,
   -- * Heaps
   -- $heaps
   Queue(..)
  ,QList(..)
  ,IndexedQueue(..)
  ,IQList(..)
  ,TaggedQueue(..)
  ,TQList(..)
  ,IndexedTaggedQueue(..)
  ,ITQList(..)
  ,
   -- * Merges
   -- $merges
   mergeQ
  ,mergeIQ
  ,mergeTQ
  ,mergeITQ
  ,
   -- * popMin
   -- $popMin
   popMinQ
  ,popMinIQ
  ,popMinTQ
  ,popMinITQ
  ,
   -- * Building
   -- $building
   buildQ
  ,buildIQ
  ,buildTQ
  ,buildITQ
  ,
   -- * Special folds
   -- $folds
   foldToMaybeTree
  ,foldToMaybeWithIndexTree)
  where

import Data.Sequence.Internal
       (Elem(..), Seq(..), Node(..), Digit(..), Sized(..), FingerTree(..),
        replicateA, foldDigit, foldNode, foldWithIndexDigit,
        foldWithIndexNode)
import Utils.Containers.Internal.State (State(..), execState)
-- | \( O(n \log n) \).  'sort' sorts the specified 'Seq' by the natural
-- ordering of its elements.  The sort is stable.  If stability is not
-- required, 'unstableSort' can be slightly faster.
--
-- @since 0.3.0
sort :: Ord a => Seq a -> Seq a
sort :: forall a. Ord a => Seq a -> Seq a
sort = (a -> a -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | \( O(n \log n) \).  'sortBy' sorts the specified 'Seq' according to the
-- specified comparator.  The sort is stable.  If stability is not required,
-- 'unstableSortBy' can be slightly faster.
--
-- @since 0.3.0
sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
sortBy :: forall a. (a -> a -> Ordering) -> Seq a -> Seq a
sortBy a -> a -> Ordering
cmp (Seq FingerTree (Elem a)
xs) =
    Seq a
-> (IndexedQueue a -> Seq a) -> Maybe (IndexedQueue a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT)
        (State (IndexedQueue a) (Seq a) -> IndexedQueue a -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State (IndexedQueue a) a -> State (IndexedQueue a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) ((IndexedQueue a -> (IndexedQueue a, a)) -> State (IndexedQueue a) a
forall s a. (s -> (s, a)) -> State s a
State ((a -> a -> Ordering) -> IndexedQueue a -> (IndexedQueue a, a)
forall e.
(e -> e -> Ordering) -> IndexedQueue e -> (IndexedQueue e, e)
popMinIQ a -> a -> Ordering
cmp))))
        ((a -> a -> Ordering)
-> (Int -> Elem a -> IndexedQueue a)
-> Int
-> FingerTree (Elem a)
-> Maybe (IndexedQueue a)
forall b y.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedQueue b)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedQueue b)
buildIQ a -> a -> Ordering
cmp (\Int
s (Elem a
x) -> Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
s a
x IQList a
forall e. IQList e
IQNil) Int
0 FingerTree (Elem a)
xs)

-- | \( O(n \log n) \). 'sortOn' sorts the specified 'Seq' by comparing
-- the results of a key function applied to each element. @'sortOn' f@ is
-- equivalent to @'sortBy' ('compare' ``Data.Function.on`` f)@, but has the
-- performance advantage of only evaluating @f@ once for each element in the
-- input list. This is called the decorate-sort-undecorate paradigm, or
-- Schwartzian transform.
--
-- An example of using 'sortOn' might be to sort a 'Seq' of strings
-- according to their length:
--
-- > sortOn length (fromList ["alligator", "monkey", "zebra"]) == fromList ["zebra", "monkey", "alligator"]
--
-- If, instead, 'sortBy' had been used, 'length' would be evaluated on
-- every comparison, giving \( O(n \log n) \) evaluations, rather than
-- \( O(n) \).
--
-- If @f@ is very cheap (for example a record selector, or 'fst'),
-- @'sortBy' ('compare' ``Data.Function.on`` f)@ will be faster than
-- @'sortOn' f@.
--
-- @since 0.5.11
sortOn :: Ord b => (a -> b) -> Seq a -> Seq a
sortOn :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
sortOn a -> b
f (Seq FingerTree (Elem a)
xs) =
    Seq a
-> (IndexedTaggedQueue b a -> Seq a)
-> Maybe (IndexedTaggedQueue b a)
-> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
       (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT)
       (State (IndexedTaggedQueue b a) (Seq a)
-> IndexedTaggedQueue b a -> Seq a
forall s a. State s a -> s -> a
execState (Int
-> State (IndexedTaggedQueue b a) a
-> State (IndexedTaggedQueue b a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) ((IndexedTaggedQueue b a -> (IndexedTaggedQueue b a, a))
-> State (IndexedTaggedQueue b a) a
forall s a. (s -> (s, a)) -> State s a
State ((b -> b -> Ordering)
-> IndexedTaggedQueue b a -> (IndexedTaggedQueue b a, a)
forall e b.
(e -> e -> Ordering)
-> IndexedTaggedQueue e b -> (IndexedTaggedQueue e b, b)
popMinITQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare))))
       ((b -> b -> Ordering)
-> (Int -> Elem a -> IndexedTaggedQueue b a)
-> Int
-> FingerTree (Elem a)
-> Maybe (IndexedTaggedQueue b a)
forall b y c.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedTaggedQueue b c)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedTaggedQueue b c)
buildITQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (\Int
s (Elem a
x) -> Int -> b -> a -> ITQList b a -> IndexedTaggedQueue b a
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
s (a -> b
f a
x) a
x ITQList b a
forall e a. ITQList e a
ITQNil) Int
0 FingerTree (Elem a)
xs)

-- | \( O(n \log n) \).  'unstableSort' sorts the specified 'Seq' by
-- the natural ordering of its elements, but the sort is not stable.
-- This algorithm is frequently faster and uses less memory than 'sort'.

-- Notes on the implementation and choice of heap are available in
-- the file sorting.md (in this directory).
--
-- @since 0.3.0
unstableSort :: Ord a => Seq a -> Seq a
unstableSort :: forall a. Ord a => Seq a -> Seq a
unstableSort = (a -> a -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
unstableSortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | \( O(n \log n) \).  A generalization of 'unstableSort', 'unstableSortBy'
-- takes an arbitrary comparator and sorts the specified sequence.
-- The sort is not stable.  This algorithm is frequently faster and
-- uses less memory than 'sortBy'.
--
-- @since 0.3.0
unstableSortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
unstableSortBy :: forall a. (a -> a -> Ordering) -> Seq a -> Seq a
unstableSortBy a -> a -> Ordering
cmp (Seq FingerTree (Elem a)
xs) =
    Seq a -> (Queue a -> Seq a) -> Maybe (Queue a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT)
        (State (Queue a) (Seq a) -> Queue a -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State (Queue a) a -> State (Queue a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) ((Queue a -> (Queue a, a)) -> State (Queue a) a
forall s a. (s -> (s, a)) -> State s a
State ((a -> a -> Ordering) -> Queue a -> (Queue a, a)
forall e. (e -> e -> Ordering) -> Queue e -> (Queue e, e)
popMinQ a -> a -> Ordering
cmp))))
        ((a -> a -> Ordering)
-> (Elem a -> Queue a) -> FingerTree (Elem a) -> Maybe (Queue a)
forall b a.
(b -> b -> Ordering)
-> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
buildQ a -> a -> Ordering
cmp (\(Elem a
x) -> a -> QList a -> Queue a
forall e. e -> QList e -> Queue e
Q a
x QList a
forall e. QList e
Nil) FingerTree (Elem a)
xs)

-- | \( O(n \log n) \). 'unstableSortOn' sorts the specified 'Seq' by
-- comparing the results of a key function applied to each element.
-- @'unstableSortOn' f@ is equivalent to @'unstableSortBy' ('compare' ``Data.Function.on`` f)@,
-- but has the performance advantage of only evaluating @f@ once for each
-- element in the input list. This is called the
-- decorate-sort-undecorate paradigm, or Schwartzian transform.
--
-- An example of using 'unstableSortOn' might be to sort a 'Seq' of strings
-- according to their length:
--
-- > unstableSortOn length (fromList ["alligator", "monkey", "zebra"]) == fromList ["zebra", "monkey", "alligator"]
--
-- If, instead, 'unstableSortBy' had been used, 'length' would be evaluated on
-- every comparison, giving \( O(n \log n) \) evaluations, rather than
-- \( O(n) \).
--
-- If @f@ is very cheap (for example a record selector, or 'fst'),
-- @'unstableSortBy' ('compare' ``Data.Function.on`` f)@ will be faster than
-- @'unstableSortOn' f@.
--
-- @since 0.5.11
unstableSortOn :: Ord b => (a -> b) -> Seq a -> Seq a
unstableSortOn :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
unstableSortOn a -> b
f (Seq FingerTree (Elem a)
xs) =
    Seq a
-> (TaggedQueue b a -> Seq a) -> Maybe (TaggedQueue b a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
       (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT)
       (State (TaggedQueue b a) (Seq a) -> TaggedQueue b a -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State (TaggedQueue b a) a -> State (TaggedQueue b a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) ((TaggedQueue b a -> (TaggedQueue b a, a))
-> State (TaggedQueue b a) a
forall s a. (s -> (s, a)) -> State s a
State ((b -> b -> Ordering) -> TaggedQueue b a -> (TaggedQueue b a, a)
forall a b.
(a -> a -> Ordering) -> TaggedQueue a b -> (TaggedQueue a b, b)
popMinTQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare))))
       ((b -> b -> Ordering)
-> (Elem a -> TaggedQueue b a)
-> FingerTree (Elem a)
-> Maybe (TaggedQueue b a)
forall b a c.
(b -> b -> Ordering)
-> (a -> TaggedQueue b c)
-> FingerTree a
-> Maybe (TaggedQueue b c)
buildTQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (\(Elem a
x) -> b -> a -> TQList b a -> TaggedQueue b a
forall a b. a -> b -> TQList a b -> TaggedQueue a b
TQ (a -> b
f a
x) a
x TQList b a
forall a b. TQList a b
TQNil) FingerTree (Elem a)
xs)

------------------------------------------------------------------------
-- $heaps
--
-- The following are definitions for various specialized pairing heaps.
--
-- All of the heaps are defined to be non-empty, which speeds up the
-- merge functions.
------------------------------------------------------------------------

-- | A simple pairing heap.
data Queue e = Q !e (QList e)
data QList e
    = Nil
    | QCons {-# UNPACK #-} !(Queue e)
            (QList e)

-- | A pairing heap tagged with the original position of elements,
-- to allow for stable sorting.
data IndexedQueue e =
    IQ {-# UNPACK #-} !Int !e (IQList e)
data IQList e
    = IQNil
    | IQCons {-# UNPACK #-} !(IndexedQueue e)
             (IQList e)

-- | A pairing heap tagged with some key for sorting elements, for use
-- in 'unstableSortOn'.
data TaggedQueue a b =
    TQ !a b (TQList a b)
data TQList a b
    = TQNil
    | TQCons {-# UNPACK #-} !(TaggedQueue a b)
             (TQList a b)

-- | A pairing heap tagged with both a key and the original position
-- of its elements, for use in 'sortOn'.
data IndexedTaggedQueue e a =
    ITQ {-# UNPACK #-} !Int !e a (ITQList e a)
data ITQList e a
    = ITQNil
    | ITQCons {-# UNPACK #-} !(IndexedTaggedQueue e a)
              (ITQList e a)

infixr 8 `ITQCons`, `TQCons`, `QCons`, `IQCons`

------------------------------------------------------------------------
-- $merges
--
-- The following are definitions for "merge" for each of the heaps
-- above. Each takes a comparison function which is used to order the
-- elements.
------------------------------------------------------------------------

-- | 'mergeQ' merges two 'Queue's.
mergeQ :: (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ :: forall a. (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ a -> a -> Ordering
cmp q1 :: Queue a
q1@(Q a
x1 QList a
ts1) q2 :: Queue a
q2@(Q a
x2 QList a
ts2)
  | a -> a -> Ordering
cmp a
x1 a
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> QList a -> Queue a
forall e. e -> QList e -> Queue e
Q a
x2 (Queue a
q1 Queue a -> QList a -> QList a
forall e. Queue e -> QList e -> QList e
`QCons` QList a
ts2)
  | Bool
otherwise       = a -> QList a -> Queue a
forall e. e -> QList e -> Queue e
Q a
x1 (Queue a
q2 Queue a -> QList a -> QList a
forall e. Queue e -> QList e -> QList e
`QCons` QList a
ts1)

-- | 'mergeTQ' merges two 'TaggedQueue's, based on the tag value.
mergeTQ :: (a -> a -> Ordering)
        -> TaggedQueue a b
        -> TaggedQueue a b
        -> TaggedQueue a b
mergeTQ :: forall a b.
(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
mergeTQ a -> a -> Ordering
cmp q1 :: TaggedQueue a b
q1@(TQ a
x1 b
y1 TQList a b
ts1) q2 :: TaggedQueue a b
q2@(TQ a
x2 b
y2 TQList a b
ts2)
  | a -> a -> Ordering
cmp a
x1 a
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = a -> b -> TQList a b -> TaggedQueue a b
forall a b. a -> b -> TQList a b -> TaggedQueue a b
TQ a
x2 b
y2 (TaggedQueue a b
q1 TaggedQueue a b -> TQList a b -> TQList a b
forall a b. TaggedQueue a b -> TQList a b -> TQList a b
`TQCons` TQList a b
ts2)
  | Bool
otherwise       = a -> b -> TQList a b -> TaggedQueue a b
forall a b. a -> b -> TQList a b -> TaggedQueue a b
TQ a
x1 b
y1 (TaggedQueue a b
q2 TaggedQueue a b -> TQList a b -> TQList a b
forall a b. TaggedQueue a b -> TQList a b -> TQList a b
`TQCons` TQList a b
ts1)

-- | 'mergeIQ' merges two 'IndexedQueue's, taking into account the
-- original position of the elements.
mergeIQ :: (a -> a -> Ordering)
        -> IndexedQueue a
        -> IndexedQueue a
        -> IndexedQueue a
mergeIQ :: forall a.
(a -> a -> Ordering)
-> IndexedQueue a -> IndexedQueue a -> IndexedQueue a
mergeIQ a -> a -> Ordering
cmp q1 :: IndexedQueue a
q1@(IQ Int
i1 a
x1 IQList a
ts1) q2 :: IndexedQueue a
q2@(IQ Int
i2 a
x2 IQList a
ts2) =
    case a -> a -> Ordering
cmp a
x1 a
x2 of
        Ordering
LT -> Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
i1 a
x1 (IndexedQueue a
q2 IndexedQueue a -> IQList a -> IQList a
forall e. IndexedQueue e -> IQList e -> IQList e
`IQCons` IQList a
ts1)
        Ordering
EQ | Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i2 -> Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
i1 a
x1 (IndexedQueue a
q2 IndexedQueue a -> IQList a -> IQList a
forall e. IndexedQueue e -> IQList e -> IQList e
`IQCons` IQList a
ts1)
        Ordering
_ -> Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
i2 a
x2 (IndexedQueue a
q1 IndexedQueue a -> IQList a -> IQList a
forall e. IndexedQueue e -> IQList e -> IQList e
`IQCons` IQList a
ts2)

-- | 'mergeITQ' merges two 'IndexedTaggedQueue's, based on the tag
-- value, taking into account the original position of the elements.
mergeITQ
    :: (a -> a -> Ordering)
    -> IndexedTaggedQueue a b
    -> IndexedTaggedQueue a b
    -> IndexedTaggedQueue a b
mergeITQ :: forall a b.
(a -> a -> Ordering)
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
mergeITQ a -> a -> Ordering
cmp q1 :: IndexedTaggedQueue a b
q1@(ITQ Int
i1 a
x1 b
y1 ITQList a b
ts1) q2 :: IndexedTaggedQueue a b
q2@(ITQ Int
i2 a
x2 b
y2 ITQList a b
ts2) =
    case a -> a -> Ordering
cmp a
x1 a
x2 of
        Ordering
LT -> Int -> a -> b -> ITQList a b -> IndexedTaggedQueue a b
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
i1 a
x1 b
y1 (IndexedTaggedQueue a b
q2 IndexedTaggedQueue a b -> ITQList a b -> ITQList a b
forall e a. IndexedTaggedQueue e a -> ITQList e a -> ITQList e a
`ITQCons` ITQList a b
ts1)
        Ordering
EQ | Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i2 -> Int -> a -> b -> ITQList a b -> IndexedTaggedQueue a b
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
i1 a
x1 b
y1 (IndexedTaggedQueue a b
q2 IndexedTaggedQueue a b -> ITQList a b -> ITQList a b
forall e a. IndexedTaggedQueue e a -> ITQList e a -> ITQList e a
`ITQCons` ITQList a b
ts1)
        Ordering
_ -> Int -> a -> b -> ITQList a b -> IndexedTaggedQueue a b
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
i2 a
x2 b
y2 (IndexedTaggedQueue a b
q1 IndexedTaggedQueue a b -> ITQList a b -> ITQList a b
forall e a. IndexedTaggedQueue e a -> ITQList e a -> ITQList e a
`ITQCons` ITQList a b
ts2)

------------------------------------------------------------------------
-- $popMin
--
-- The following are definitions for @popMin@, a function which
-- constructs a stateful action which pops the smallest element from the
-- queue, where "smallest" is according to the supplied comparison
-- function.
--
-- All of the functions fail on an empty queue.
--
-- Each of these functions is structured something like this:
--
-- @popMinQ cmp (Q x ts) = (mergeQs ts, x)@
--
-- The reason the call to @mergeQs@ is lazy is that it will be bottom
-- for the last element in the queue, preventing us from evaluating the
-- fully sorted sequence.
------------------------------------------------------------------------

-- | Pop the smallest element from the queue, using the supplied
-- comparator.
popMinQ :: (e -> e -> Ordering) -> Queue e -> (Queue e, e)
popMinQ :: forall e. (e -> e -> Ordering) -> Queue e -> (Queue e, e)
popMinQ e -> e -> Ordering
cmp (Q e
x QList e
xs) = (QList e -> Queue e
mergeQs QList e
xs, e
x)
  where
    mergeQs :: QList e -> Queue e
mergeQs (Queue e
t `QCons` QList e
Nil) = Queue e
t
    mergeQs (Queue e
t1 `QCons` Queue e
t2 `QCons` QList e
Nil) = Queue e
t1 Queue e -> Queue e -> Queue e
<+> Queue e
t2
    mergeQs (Queue e
t1 `QCons` Queue e
t2 `QCons` QList e
ts) = (Queue e
t1 Queue e -> Queue e -> Queue e
<+> Queue e
t2) Queue e -> Queue e -> Queue e
<+> QList e -> Queue e
mergeQs QList e
ts
    mergeQs QList e
Nil = [Char] -> Queue e
forall a. HasCallStack => [Char] -> a
error [Char]
"popMinQ: tried to pop from empty queue"
    <+> :: Queue e -> Queue e -> Queue e
(<+>) = (e -> e -> Ordering) -> Queue e -> Queue e -> Queue e
forall a. (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ e -> e -> Ordering
cmp

-- | Pop the smallest element from the queue, using the supplied
-- comparator, deferring to the item's original position when the
-- comparator returns 'EQ'.
popMinIQ :: (e -> e -> Ordering) -> IndexedQueue e -> (IndexedQueue e, e)
popMinIQ :: forall e.
(e -> e -> Ordering) -> IndexedQueue e -> (IndexedQueue e, e)
popMinIQ e -> e -> Ordering
cmp (IQ Int
_ e
x IQList e
xs) = (IQList e -> IndexedQueue e
mergeQs IQList e
xs, e
x)
  where
    mergeQs :: IQList e -> IndexedQueue e
mergeQs (IndexedQueue e
t `IQCons` IQList e
IQNil) = IndexedQueue e
t
    mergeQs (IndexedQueue e
t1 `IQCons` IndexedQueue e
t2 `IQCons` IQList e
IQNil) = IndexedQueue e
t1 IndexedQueue e -> IndexedQueue e -> IndexedQueue e
<+> IndexedQueue e
t2
    mergeQs (IndexedQueue e
t1 `IQCons` IndexedQueue e
t2 `IQCons` IQList e
ts) = (IndexedQueue e
t1 IndexedQueue e -> IndexedQueue e -> IndexedQueue e
<+> IndexedQueue e
t2) IndexedQueue e -> IndexedQueue e -> IndexedQueue e
<+> IQList e -> IndexedQueue e
mergeQs IQList e
ts
    mergeQs IQList e
IQNil = [Char] -> IndexedQueue e
forall a. HasCallStack => [Char] -> a
error [Char]
"popMinQ: tried to pop from empty queue"
    <+> :: IndexedQueue e -> IndexedQueue e -> IndexedQueue e
(<+>) = (e -> e -> Ordering)
-> IndexedQueue e -> IndexedQueue e -> IndexedQueue e
forall a.
(a -> a -> Ordering)
-> IndexedQueue a -> IndexedQueue a -> IndexedQueue a
mergeIQ e -> e -> Ordering
cmp

-- | Pop the smallest element from the queue, using the supplied
-- comparator on the tag.
popMinTQ :: (a -> a -> Ordering) -> TaggedQueue a b -> (TaggedQueue a b, b)
popMinTQ :: forall a b.
(a -> a -> Ordering) -> TaggedQueue a b -> (TaggedQueue a b, b)
popMinTQ a -> a -> Ordering
cmp (TQ a
_ b
x TQList a b
xs) = (TQList a b -> TaggedQueue a b
forall {b}. TQList a b -> TaggedQueue a b
mergeQs TQList a b
xs, b
x)
  where
    mergeQs :: TQList a b -> TaggedQueue a b
mergeQs (TaggedQueue a b
t `TQCons` TQList a b
TQNil) = TaggedQueue a b
t
    mergeQs (TaggedQueue a b
t1 `TQCons` TaggedQueue a b
t2 `TQCons` TQList a b
TQNil) = TaggedQueue a b
t1 TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall {b}. TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
<+> TaggedQueue a b
t2
    mergeQs (TaggedQueue a b
t1 `TQCons` TaggedQueue a b
t2 `TQCons` TQList a b
ts) = (TaggedQueue a b
t1 TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall {b}. TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
<+> TaggedQueue a b
t2) TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall {b}. TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
<+> TQList a b -> TaggedQueue a b
mergeQs TQList a b
ts
    mergeQs TQList a b
TQNil = [Char] -> TaggedQueue a b
forall a. HasCallStack => [Char] -> a
error [Char]
"popMinQ: tried to pop from empty queue"
    <+> :: TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
(<+>) = (a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall a b.
(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
mergeTQ a -> a -> Ordering
cmp

-- | Pop the smallest element from the queue, using the supplied
-- comparator on the tag, deferring to the item's original position
-- when the comparator returns 'EQ'.
popMinITQ :: (e -> e -> Ordering)
          -> IndexedTaggedQueue e b
          -> (IndexedTaggedQueue e b, b)
popMinITQ :: forall e b.
(e -> e -> Ordering)
-> IndexedTaggedQueue e b -> (IndexedTaggedQueue e b, b)
popMinITQ e -> e -> Ordering
cmp (ITQ Int
_ e
_ b
x ITQList e b
xs) = (ITQList e b -> IndexedTaggedQueue e b
forall {b}. ITQList e b -> IndexedTaggedQueue e b
mergeQs ITQList e b
xs, b
x)
  where
    mergeQs :: ITQList e b -> IndexedTaggedQueue e b
mergeQs (IndexedTaggedQueue e b
t `ITQCons` ITQList e b
ITQNil) = IndexedTaggedQueue e b
t
    mergeQs (IndexedTaggedQueue e b
t1 `ITQCons` IndexedTaggedQueue e b
t2 `ITQCons` ITQList e b
ITQNil) = IndexedTaggedQueue e b
t1 IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
forall {b}.
IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
<+> IndexedTaggedQueue e b
t2
    mergeQs (IndexedTaggedQueue e b
t1 `ITQCons` IndexedTaggedQueue e b
t2 `ITQCons` ITQList e b
ts) = (IndexedTaggedQueue e b
t1 IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
forall {b}.
IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
<+> IndexedTaggedQueue e b
t2) IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
forall {b}.
IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
<+> ITQList e b -> IndexedTaggedQueue e b
mergeQs ITQList e b
ts
    mergeQs ITQList e b
ITQNil = [Char] -> IndexedTaggedQueue e b
forall a. HasCallStack => [Char] -> a
error [Char]
"popMinQ: tried to pop from empty queue"
    <+> :: IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
(<+>) = (e -> e -> Ordering)
-> IndexedTaggedQueue e b
-> IndexedTaggedQueue e b
-> IndexedTaggedQueue e b
forall a b.
(a -> a -> Ordering)
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
mergeITQ e -> e -> Ordering
cmp

------------------------------------------------------------------------
-- $building
--
-- The following are definitions for functions to build queues, given a
-- comparison function.
------------------------------------------------------------------------

buildQ :: (b -> b -> Ordering) -> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
buildQ :: forall b a.
(b -> b -> Ordering)
-> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
buildQ b -> b -> Ordering
cmp = (Queue b -> Queue b -> Queue b)
-> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree ((b -> b -> Ordering) -> Queue b -> Queue b -> Queue b
forall a. (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ b -> b -> Ordering
cmp)

buildIQ
    :: (b -> b -> Ordering)
    -> (Int -> Elem y -> IndexedQueue b)
    -> Int
    -> FingerTree (Elem y)
    -> Maybe (IndexedQueue b)
buildIQ :: forall b y.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedQueue b)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedQueue b)
buildIQ b -> b -> Ordering
cmp = (IndexedQueue b -> IndexedQueue b -> IndexedQueue b)
-> (Int -> Elem y -> IndexedQueue b)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedQueue b)
forall b y.
(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
foldToMaybeWithIndexTree ((b -> b -> Ordering)
-> IndexedQueue b -> IndexedQueue b -> IndexedQueue b
forall a.
(a -> a -> Ordering)
-> IndexedQueue a -> IndexedQueue a -> IndexedQueue a
mergeIQ b -> b -> Ordering
cmp)

buildTQ
    :: (b -> b -> Ordering)
    -> (a -> TaggedQueue b c)
    -> FingerTree a
    -> Maybe (TaggedQueue b c)
buildTQ :: forall b a c.
(b -> b -> Ordering)
-> (a -> TaggedQueue b c)
-> FingerTree a
-> Maybe (TaggedQueue b c)
buildTQ b -> b -> Ordering
cmp = (TaggedQueue b c -> TaggedQueue b c -> TaggedQueue b c)
-> (a -> TaggedQueue b c)
-> FingerTree a
-> Maybe (TaggedQueue b c)
forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree ((b -> b -> Ordering)
-> TaggedQueue b c -> TaggedQueue b c -> TaggedQueue b c
forall a b.
(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
mergeTQ b -> b -> Ordering
cmp)

buildITQ
    :: (b -> b -> Ordering)
    -> (Int -> Elem y -> IndexedTaggedQueue b c)
    -> Int
    -> FingerTree (Elem y)
    -> Maybe (IndexedTaggedQueue b c)
buildITQ :: forall b y c.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedTaggedQueue b c)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedTaggedQueue b c)
buildITQ b -> b -> Ordering
cmp = (IndexedTaggedQueue b c
 -> IndexedTaggedQueue b c -> IndexedTaggedQueue b c)
-> (Int -> Elem y -> IndexedTaggedQueue b c)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedTaggedQueue b c)
forall b y.
(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
foldToMaybeWithIndexTree ((b -> b -> Ordering)
-> IndexedTaggedQueue b c
-> IndexedTaggedQueue b c
-> IndexedTaggedQueue b c
forall a b.
(a -> a -> Ordering)
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
mergeITQ b -> b -> Ordering
cmp)

------------------------------------------------------------------------
-- $folds
--
-- A big part of what makes the heaps fast is that they're non empty,
-- so the merge function can avoid an extra case match. To take
-- advantage of this, though, we need specialized versions of 'foldMap'
-- and 'Data.Sequence.foldMapWithIndex', which can alternate between
-- calling the faster semigroup-like merge when folding over non empty
-- structures (like 'Node' and 'Digit'), and the
-- 'Data.Semirgroup.Option'-like mappend, when folding over structures
-- which can be empty (like 'FingerTree').
------------------------------------------------------------------------

-- | A 'foldMap'-like function, specialized to the
-- 'Data.Semigroup.Option' monoid, which takes advantage of the
-- internal structure of 'Seq' to avoid wrapping in 'Maybe' at certain
-- points.
foldToMaybeTree :: (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree :: forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree b -> b -> b
_ a -> b
_ FingerTree a
EmptyT = Maybe b
forall a. Maybe a
Nothing
foldToMaybeTree b -> b -> b
_ a -> b
f (Single a
xs) = b -> Maybe b
forall a. a -> Maybe a
Just (a -> b
f a
xs)
foldToMaybeTree b -> b -> b
(<+>) a -> b
f (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) =
    b -> Maybe b
forall a. a -> Maybe a
Just (b -> (b -> b) -> Maybe b -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
pr' b -> b -> b
<+> b
sf') ((b
pr' b -> b -> b
<+> b
sf') b -> b -> b
<+>) Maybe b
m')
  where
    pr' :: b
pr' = (b -> b -> b) -> (a -> b) -> Digit a -> b
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
(<+>) a -> b
f Digit a
pr
    sf' :: b
sf' = (b -> b -> b) -> (a -> b) -> Digit a -> b
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
(<+>) a -> b
f Digit a
sf
    m' :: Maybe b
m' = (b -> b -> b) -> (Node a -> b) -> FingerTree (Node a) -> Maybe b
forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree b -> b -> b
(<+>) ((b -> b -> b) -> (a -> b) -> Node a -> b
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode b -> b -> b
(<+>) a -> b
f) FingerTree (Node a)
m

-- | A 'Data.Sequence.foldMapWithIndex'-like function, specialized to the
-- 'Data.Semigroup.Option' monoid, which takes advantage of the
-- internal structure of 'Seq' to avoid wrapping in 'Maybe' at certain
-- points.
foldToMaybeWithIndexTree :: (b -> b -> b)
                         -> (Int -> Elem y -> b)
                         -> Int
                         -> FingerTree (Elem y)
                         -> Maybe b
foldToMaybeWithIndexTree :: forall b y.
(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
foldToMaybeWithIndexTree = (b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
foldToMaybeWithIndexTree'
  where
    {-# SPECIALISE foldToMaybeWithIndexTree' :: (b -> b -> b) -> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b #-}
    {-# SPECIALISE foldToMaybeWithIndexTree' :: (b -> b -> b) -> (Int -> Node y -> b) -> Int -> FingerTree (Node y) -> Maybe b #-}
    foldToMaybeWithIndexTree'
        :: Sized a
        => (b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
    foldToMaybeWithIndexTree' :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
foldToMaybeWithIndexTree' b -> b -> b
_ Int -> a -> b
_ !Int
_s FingerTree a
EmptyT = Maybe b
forall a. Maybe a
Nothing
    foldToMaybeWithIndexTree' b -> b -> b
_ Int -> a -> b
f Int
s (Single a
xs) = b -> Maybe b
forall a. a -> Maybe a
Just (Int -> a -> b
f Int
s a
xs)
    foldToMaybeWithIndexTree' b -> b -> b
(<+>) Int -> a -> b
f Int
s (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) =
        b -> Maybe b
forall a. a -> Maybe a
Just (b -> (b -> b) -> Maybe b -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b
pr' b -> b -> b
<+> b
sf') ((b
pr' b -> b -> b
<+> b
sf') b -> b -> b
<+>) Maybe b
m')
      where
        pr' :: b
pr' = (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
digit b -> b -> b
(<+>) Int -> a -> b
f Int
s Digit a
pr
        sf' :: b
sf' = (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
digit b -> b -> b
(<+>) Int -> a -> b
f Int
sPsprm Digit a
sf
        m' :: Maybe b
m' = (b -> b -> b)
-> (Int -> Node a -> b) -> Int -> FingerTree (Node a) -> Maybe b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
foldToMaybeWithIndexTree' b -> b -> b
(<+>) ((b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
node b -> b -> b
(<+>) Int -> a -> b
f) Int
sPspr FingerTree (Node a)
m
        !sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
        !sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m
    {-# SPECIALISE digit :: (b -> b -> b) -> (Int -> Elem y -> b) -> Int -> Digit (Elem y) -> b #-}
    {-# SPECIALISE digit :: (b -> b -> b) -> (Int -> Node y -> b) -> Int -> Digit (Node y) -> b #-}
    digit
        :: Sized a
        => (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
    digit :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
digit = (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit
    {-# SPECIALISE node :: (b -> b -> b) -> (Int -> Elem y -> b) -> Int -> Node (Elem y) -> b #-}
    {-# SPECIALISE node :: (b -> b -> b) -> (Int -> Node y -> b) -> Int -> Node (Node y) -> b #-}
    node
        :: Sized a
        => (b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
    node :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
node = (b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
foldWithIndexNode
{-# INLINE foldToMaybeWithIndexTree #-}