From 64ee757d9d6270d20ef3068f6adfff958d667a26 Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Tue, 7 Dec 2021 17:22:09 -0500
Subject: [PATCH] Remove all orphan instances

* Remove all orphan instances.

* One of the `unions` definitions used `foldl`; make it use `foldl'`
  instead.

* Remove false caveat about amortized bounds. They definitely *do*
  hold in a persistent setting, and we're very careful to maintain
  that! Someone must have confused lazy-spined binomial queues with
  strict-spined ones.
---
 pqueue.cabal                          |   2 +-
 src/Data/PQueue/Internals.hs          | 117 +++++-
 src/Data/PQueue/Internals/Down.hs     |  31 ++
 src/Data/PQueue/Max.hs                |   2 +-
 src/Data/PQueue/Min.hs                | 104 ------
 src/Data/PQueue/Prio/Internals.hs     | 146 +++++++-
 src/Data/PQueue/Prio/Max.hs           | 397 +-------------------
 src/Data/PQueue/Prio/Max/Internals.hs | 506 ++++++++++++++++++++++++--
 src/Data/PQueue/Prio/Min.hs           | 113 +-----
 9 files changed, 771 insertions(+), 647 deletions(-)
 create mode 100644 src/Data/PQueue/Internals/Down.hs

diff --git a/pqueue.cabal b/pqueue.cabal
index 094c2e9..3a2b813 100644
--- a/pqueue.cabal
+++ b/pqueue.cabal
@@ -36,6 +36,7 @@ library
   other-modules:
     Data.PQueue.Prio.Internals
     Data.PQueue.Internals
+    Data.PQueue.Internals.Down
     Data.PQueue.Prio.Max.Internals
     Control.Applicative.Identity
   if impl(ghc) {
@@ -73,7 +74,6 @@ test-Suite test
   }
   ghc-options: {
     -Wall
-    -fno-warn-inline-rule-shadowing
   }
   if impl(ghc >= 8.0) {
     ghc-options: {
diff --git a/src/Data/PQueue/Internals.hs b/src/Data/PQueue/Internals.hs
index bf0a269..9dff736 100644
--- a/src/Data/PQueue/Internals.hs
+++ b/src/Data/PQueue/Internals.hs
@@ -22,31 +22,48 @@ module Data.PQueue.Internals (
   mapMonotonic,
   foldrAsc,
   foldlAsc,
+  foldrDesc,
   foldrUnfold,
   foldlUnfold,
   insertMinQ,
   insertMinQ',
   insertMaxQ',
+  toAscList,
+  toDescList,
+  toListU,
   fromList,
---   mapU,
+  mapU,
+  fromAscList,
   foldrU,
   foldlU,
 --   traverseU,
   keysQueue,
-  seqSpine
+  seqSpine,
+  unions
   ) where
 
 import Control.DeepSeq (NFData(rnf), deepseq)
 import Data.Foldable (foldl')
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>)))
+#endif
 
 import qualified Data.PQueue.Prio.Internals as Prio
 
 #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 !(BinomHeap a)
 
@@ -212,6 +229,10 @@ insert = insert' (<=)
 union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
 union = union' (<=)
 
+-- | Takes the union of a list of priority queues. Equivalent to @'foldl'' 'union' 'empty'@.
+unions :: Ord a => [MinQueue a] -> MinQueue a
+unions = foldl' union empty
+
 -- | /O(n)/. Map elements and collect the 'Just' results.
 mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
 mapMaybe _ Empty = Empty
@@ -238,6 +259,12 @@ foldrAsc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
 foldrAsc _ z Empty = z
 foldrAsc f z (MinQueue _ x ts) = x `f` foldrUnfold f z extractHeap 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 = foldlAsc . flip
+{-# INLINE [0] foldrDesc #-}
+
 {-# INLINE foldrUnfold #-}
 -- | Equivalent to @foldr f z (unfoldr suc s0)@.
 foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
@@ -260,6 +287,44 @@ foldlUnfold f z0 suc s0 = unf z0 s0 where
     Nothing      -> z
     Just (x, s') -> unf (z `f` x) s'
 
+{-# INLINABLE [1] toAscList #-}
+-- | /O(n log n)/. Extracts the elements of the priority queue in ascending order.
+toAscList :: Ord a => MinQueue a -> [a]
+toAscList queue = foldrAsc (:) [] queue
+
+{-# INLINABLE toAscListApp #-}
+toAscListApp :: Ord a => MinQueue a -> [a] -> [a]
+toAscListApp Empty app = app
+toAscListApp (MinQueue _ x ts) app = x : foldrUnfold (:) app extractHeap 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 queue = foldrDesc (:) [] queue
+
+{-# INLINABLE toDescListApp #-}
+toDescListApp :: Ord a => MinQueue a -> [a] -> [a]
+toDescListApp Empty app = app
+toDescListApp (MinQueue _ x ts) app = foldlUnfold (flip (:)) (x : app) extractHeap 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 xs = foldl' (flip insertMaxQ') empty xs
+
 insert' :: LEq a -> a -> MinQueue a -> MinQueue a
 insert' _ x Empty = singleton x
 insert' le x (MinQueue n x' ts)
@@ -374,7 +439,7 @@ insertMinQ x Empty = singleton x
 insertMinQ x (MinQueue n x' f) = MinQueue (n + 1) x (insertMin (tip x') f)
 
 -- | @insertMin t f@ assumes that the root of @t@ compares as less than
--- every other root in @f@, and merges accordingly.
+-- or equal to every other root in @f@, and merges accordingly.
 insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
 insertMin t Nil = Cons t Nil
 insertMin t (Skip f) = Cons t f
@@ -590,6 +655,21 @@ foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
 foldlU _ z Empty = z
 foldlU f z (MinQueue _ x ts) = foldl f (z `f` x) ts
 
+{-# NOINLINE toListU #-}
+-- | /O(n)/. Returns the elements of the queue, in no particular order.
+toListU :: MinQueue a -> [a]
+toListU q = foldrU (:) [] q
+
+{-# NOINLINE toListUApp #-}
+toListUApp :: MinQueue a -> [a] -> [a]
+toListUApp Empty app = app
+toListUApp (MinQueue _ x ts) app = x : foldr (:) app 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
@@ -643,3 +723,34 @@ instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where
 instance NFData a => NFData (MinQueue a) where
   rnf Empty             = ()
   rnf (MinQueue _ x ts) = x `deepseq` rnf ts
+
+instance (Ord a, Show a) => Show (MinQueue a) where
+  showsPrec p xs = showParen (p > 10) $
+    showString "fromAscList " . shows (toAscList xs)
+
+instance Read a => Read (MinQueue a) where
+#ifdef __GLASGOW_HASKELL__
+  readPrec = parens $ prec 10 $ do
+    Ident "fromAscList" <- lexP
+    xs <- readPrec
+    return (fromAscList xs)
+
+  readListPrec = 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
+  (<>) = union
+#endif
+
+instance Ord a => Monoid (MinQueue a) where
+  mempty = empty
+#if !MIN_VERSION_base(4,11,0)
+  mappend = union
+#endif
+  mconcat = unions
diff --git a/src/Data/PQueue/Internals/Down.hs b/src/Data/PQueue/Internals/Down.hs
new file mode 100644
index 0000000..6a84832
--- /dev/null
+++ b/src/Data/PQueue/Internals/Down.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE CPP #-}
+
+module Data.PQueue.Internals.Down where
+
+import Control.DeepSeq (NFData(rnf))
+
+#if __GLASGOW_HASKELL__
+import Data.Data (Data)
+#endif
+
+newtype Down a = Down { unDown :: a }
+# if __GLASGOW_HASKELL__
+  deriving (Eq, Data)
+# else
+  deriving (Eq)
+# endif
+
+
+instance NFData a => NFData (Down a) where
+  rnf (Down a) = rnf a
+
+instance Ord a => Ord (Down a) where
+  Down a `compare` Down b = b `compare` a
+  Down a <= Down b = b <= a
+
+instance Functor Down where
+  fmap f (Down a) = Down (f a)
+
+instance Foldable Down where
+  foldr f z (Down a) = a `f` z
+  foldl f z (Down a) = z `f` a
diff --git a/src/Data/PQueue/Max.hs b/src/Data/PQueue/Max.hs
index b3c8aa7..f176a11 100644
--- a/src/Data/PQueue/Max.hs
+++ b/src/Data/PQueue/Max.hs
@@ -90,7 +90,7 @@ import Data.Semigroup (Semigroup((<>)))
 
 import qualified Data.PQueue.Min as Min
 import qualified Data.PQueue.Prio.Max.Internals as Prio
-import Data.PQueue.Prio.Max.Internals (Down(..))
+import Data.PQueue.Internals.Down (Down(..))
 
 import Prelude hiding (null, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter)
 
diff --git a/src/Data/PQueue/Min.hs b/src/Data/PQueue/Min.hs
index 7512474..34704ad 100644
--- a/src/Data/PQueue/Min.hs
+++ b/src/Data/PQueue/Min.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -95,46 +94,11 @@ import Data.PQueue.Internals
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
-import Text.Read (Lexeme(Ident), lexP, parens, prec,
-  readPrec, readListPrec, readListPrecDefault)
 #else
 build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
 build f = f (:) []
 #endif
 
--- instance
-
-instance (Ord a, Show a) => Show (MinQueue a) where
-  showsPrec p xs = showParen (p > 10) $
-    showString "fromAscList " . shows (toAscList xs)
-
-instance Read a => Read (MinQueue a) where
-#ifdef __GLASGOW_HASKELL__
-  readPrec = parens $ prec 10 $ do
-    Ident "fromAscList" <- lexP
-    xs <- readPrec
-    return (fromAscList xs)
-
-  readListPrec = 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
-  (<>) = union
-#endif
-
-instance Ord a => Monoid (MinQueue a) where
-  mempty = empty
-#if !MIN_VERSION_base(4,11,0)
-  mappend = union
-#endif
-  mconcat = unions
-
 -- | /O(1)/. Returns the minimum element. Throws an error on an empty queue.
 findMin :: MinQueue a -> a
 findMin = fromMaybe (error "Error: findMin called on empty queue") . getMin
@@ -149,10 +113,6 @@ deleteMin q = case minView q of
 deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)
 deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView
 
--- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@.
-unions :: Ord a => [MinQueue a] -> MinQueue a
-unions = foldl union empty
-
 -- | /O(k log n)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest
 -- element in the queue. Equivalent to @toAscList queue !! k@.
 (!!) :: Ord a => MinQueue a -> Int -> a
@@ -232,26 +192,6 @@ partition p = mapEither (\x -> if p x then Left x else Right x)
 map :: Ord b => (a -> b) -> MinQueue a -> MinQueue b
 map f = foldrU (insert . f) empty
 
-{-# INLINABLE [1] toAscList #-}
--- | /O(n log n)/. Extracts the elements of the priority queue in ascending order.
-toAscList :: Ord a => MinQueue a -> [a]
-toAscList queue = foldrAsc (:) [] queue
-
-{-# INLINABLE toAscListApp #-}
-toAscListApp :: Ord a => MinQueue a -> [a] -> [a]
-toAscListApp Empty app = app
-toAscListApp (MinQueue _ x ts) app = x : foldrUnfold (:) app extractHeap 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 queue = foldrDesc (:) [] queue
-
-{-# INLINABLE toDescListApp #-}
-toDescListApp :: Ord a => MinQueue a -> [a] -> [a]
-toDescListApp Empty app = app
-toDescListApp (MinQueue _ x ts) app = foldlUnfold (flip (:)) (x : app) extractHeap ts
-
 {-# INLINE toList #-}
 -- | /O(n log n)/. Returns the elements of the priority queue in ascending order. Equivalent to 'toAscList'.
 --
@@ -259,61 +199,17 @@ toDescListApp (MinQueue _ x ts) app = foldlUnfold (flip (:)) (x : app) extractHe
 toList :: Ord a => MinQueue a -> [a]
 toList = toAscList
 
-{-# 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
- #-}
-
--- | /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 = foldlAsc . flip
-{-# INLINE [0] foldrDesc #-}
-
 -- | /O(n log n)/. Performs a left fold on the elements of a priority queue in descending order.
 -- @foldlDesc f z q == foldrAsc (flip f) z q@.
 foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
 foldlDesc = foldrAsc . flip
 
-{-# 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 xs = foldl' (flip insertMaxQ') empty xs
-
 {-# INLINE fromDescList #-}
 -- | /O(n)/. Constructs a priority queue from an descending list. /Warning/: Does not check the precondition.
 fromDescList :: [a] -> MinQueue a
 -- We apply an explicit argument to get foldl' to inline.
 fromDescList xs = foldl' (flip insertMinQ') empty xs
 
--- | Maps a function over the elements of the queue, ignoring order. This function is only safe if the function is monotonic.
--- This function /does not/ check the precondition.
-mapU :: (a -> b) -> MinQueue a -> MinQueue b
-mapU = mapMonotonic
-
 -- | Equivalent to 'toListU'.
 elemsU :: MinQueue a -> [a]
 elemsU = toListU
-
-{-# NOINLINE toListU #-}
--- | /O(n)/. Returns the elements of the queue, in no particular order.
-toListU :: MinQueue a -> [a]
-toListU q = foldrU (:) [] q
-
-{-# NOINLINE toListUApp #-}
-toListUApp :: MinQueue a -> [a] -> [a]
-toListUApp Empty app = app
-toListUApp (MinQueue _ x ts) app = x : foldr (:) app 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
-  #-}
diff --git a/src/Data/PQueue/Prio/Internals.hs b/src/Data/PQueue/Prio/Internals.hs
index de9cbf6..b39aec4 100644
--- a/src/Data/PQueue/Prio/Internals.hs
+++ b/src/Data/PQueue/Prio/Internals.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Data.PQueue.Prio.Internals (
   MinPQueue(..),
@@ -25,30 +26,50 @@ module Data.PQueue.Prio.Internals (
   mapEitherWithKey,
   foldrWithKey,
   foldlWithKey,
+  foldrU,
+  toAscList,
+  toDescList,
+  toListU,
   insertMin,
   insertMin',
   insertMax',
   fromList,
+  fromAscList,
   foldrWithKeyU,
   foldlWithKeyU,
+  traverseWithKey,
+  mapMWithKey,
   traverseWithKeyU,
   seqSpine,
-  mapForest
+  mapForest,
+  unions
   ) where
 
 import Control.Applicative.Identity (Identity(Identity, runIdentity))
 import Control.Applicative (liftA2, liftA3)
 import Control.DeepSeq (NFData(rnf), deepseq)
-import Data.List (foldl')
+import qualified Data.List as List
 
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>)))
+#else
 import Data.Monoid ((<>))
+#endif
 
-import Prelude hiding (null)
-
-#if __GLASGOW_HASKELL__
-
+import Prelude hiding (null, map)
+#ifdef __GLASGOW_HASKELL__
 import Data.Data
+import GHC.Exts (build)
+import Text.Read (Lexeme(Ident), lexP, parens, prec,
+  readPrec, readListPrec, readListPrecDefault)
+#endif
+
+#ifndef __GLASGOW_HASKELL__
+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
+build f = f (:) []
+#endif
 
+#if __GLASGOW_HASKELL__
 instance (Data k, Data a, Ord k) => Data (MinPQueue k a) where
   gfoldl f z m = z fromList `f` foldrWithKey (curry (:)) [] m
   toConstr _   = fromListConstr
@@ -67,6 +88,42 @@ fromListConstr = mkConstr queueDataType "fromList" [] Prefix
 
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+instance Ord k => Semigroup (MinPQueue k a) where
+  (<>) = union
+#endif
+
+instance Ord k => Monoid (MinPQueue k a) where
+  mempty = empty
+#if !MIN_VERSION_base(4,11,0)
+  mappend = union
+#endif
+  mconcat = unions
+
+instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where
+  showsPrec p xs = showParen (p > 10) $
+    showString "fromAscList " . shows (toAscList xs)
+
+instance (Read k, Read a) => Read (MinPQueue k a) where
+#ifdef __GLASGOW_HASKELL__
+  readPrec = parens $ prec 10 $ do
+    Ident "fromAscList" <- lexP
+    xs <- readPrec
+    return (fromAscList xs)
+
+  readListPrec = readListPrecDefault
+#else
+  readsPrec p = readParen (p > 10) $ \r -> do
+    ("fromAscList",s) <- lex r
+    (xs,t) <- reads s
+    return (fromAscList xs,t)
+#endif
+
+-- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).
+unions :: Ord k => [MinPQueue k a] -> MinPQueue k a
+unions = List.foldl' union empty
+
+
 (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
 (f .: g) x y = f (g x y)
 
@@ -253,6 +310,36 @@ foldlWithKey f z0 (MinPQ _ k0 a0 ts0) = foldF (f z0 k0 a0) ts0 where
     Yes (Extract k a _ ts') -> foldF (f z k a) ts'
     _                       -> z
 
+{-# INLINABLE [1] toAscList #-}
+-- | /O(n log n)/. Return all (key, value) pairs in ascending order by key.
+toAscList :: Ord k => MinPQueue k a -> [(k, a)]
+toAscList = foldrWithKey (curry (:)) []
+
+{-# INLINABLE [1] toDescList #-}
+-- | /O(n log n)/. Return all (key, value) pairs in descending order by key.
+toDescList :: Ord k => MinPQueue k a -> [(k, a)]
+toDescList = foldlWithKey (\z k a -> (k, a) : z) []
+
+-- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./
+fromAscList :: [(k, a)] -> MinPQueue k a
+{-# INLINE fromAscList #-}
+fromAscList xs = List.foldl' (\q (k, a) -> insertMax' k a q) empty xs
+
+{-# RULES
+  "toAscList" toAscList = \q -> build (\c n -> foldrWithKey (curry c) n q);
+  "toDescList" toDescList = \q -> build (\c n -> foldlWithKey (\z k a -> (k, a) `c` z) n q);
+  "toListU" toListU = \q -> build (\c n -> foldrWithKeyU (curry c) n q);
+  #-}
+
+{-# NOINLINE toListU #-}
+-- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order.
+toListU :: MinPQueue k a -> [(k, a)]
+toListU = foldrWithKeyU (curry (:)) []
+
+-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
+foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b
+foldrU = foldrWithKeyU . const
+
 -- | Equivalent to 'insert', save the assumption that this key is @<=@
 -- every other key in the map. /The precondition is not checked./
 insertMin :: k -> a -> MinPQueue k a -> MinPQueue k a
@@ -289,7 +376,7 @@ fromList xs = case extractForest (<=) (fromListHeap (<=) xs) of
 
 {-# INLINE fromListHeap #-}
 fromListHeap :: CompF k -> [(k, a)] -> BinomHeap k a
-fromListHeap le xs = foldl' go Nil xs
+fromListHeap le xs = List.foldl' go Nil xs
   where
     go fr (k, a) = incr' le (tip k a) fr
 
@@ -503,6 +590,35 @@ foldlWithKeyU :: (b -> k -> a -> b) -> b -> MinPQueue k a -> b
 foldlWithKeyU _ z Empty = z
 foldlWithKeyU f z0 (MinPQ _ k0 a0 ts) = foldlWithKeyF_ (\k a z -> f z k a) (const id) ts (f z0 k0 a0)
 
+-- | /O(n)/. Map a function over all values in the queue.
+map :: (a -> b) -> MinPQueue k a -> MinPQueue k b
+map = mapWithKey . const
+
+-- | /O(n log n)/. Traverses the elements of the queue in ascending order by key.
+-- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@)
+--
+-- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.
+--
+-- If you are working in a strict monad, consider using 'mapMWithKey'.
+traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
+traverseWithKey f q = case minViewWithKey q of
+  Nothing      -> pure empty
+  Just ((k, a), q')  -> liftA2 (insertMin k) (f k a) (traverseWithKey f q')
+
+-- | A strictly accumulating version of 'traverseWithKey'. This works well in
+-- 'IO' and strict @State@, and is likely what you want for other "strict" monads,
+-- where @⊥ >>= pure () = ⊥@.
+mapMWithKey :: (Ord k, Monad m) => (k -> a -> m b) -> MinPQueue k a -> m (MinPQueue k b)
+mapMWithKey f = go empty
+  where
+    go !acc q =
+      case minViewWithKey q of
+        Nothing           -> pure acc
+        Just ((k, a), q') -> do
+          b <- f k a
+          let !acc' = insertMax' k b acc
+          go acc' q'
+
 -- | /O(n)/. An unordered traversal over a priority queue, in no particular order.
 -- While there is no guarantee in which order the elements are traversed, the resulting
 -- priority queue will be perfectly valid.
@@ -591,3 +707,19 @@ instance (NFData k, NFData a, NFRank rk) => NFData (BinomForest rk k a) where
 instance (NFData k, NFData a) => NFData (MinPQueue k a) where
   rnf Empty = ()
   rnf (MinPQ _ k a ts) = k `deepseq` a `deepseq` rnf ts
+
+instance Functor (MinPQueue k) where
+  fmap = map
+
+instance Ord k => Foldable (MinPQueue k) where
+  foldr   = foldrWithKey . const
+  foldl f = foldlWithKey (const . f)
+  length = size
+  null = null
+
+-- | Traverses in ascending order. 'mapM' is strictly accumulating like
+-- 'mapMWithKey'.
+instance Ord k => Traversable (MinPQueue k) where
+  traverse = traverseWithKey . const
+  mapM = mapMWithKey . const
+  sequence = mapM id
diff --git a/src/Data/PQueue/Prio/Max.hs b/src/Data/PQueue/Prio/Max.hs
index 9170e55..d5938d1 100644
--- a/src/Data/PQueue/Prio/Max.hs
+++ b/src/Data/PQueue/Prio/Max.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.PQueue.Prio.Max
@@ -16,7 +12,7 @@
 -- viewing and extracting the element with the maximum key.
 --
 -- A worst-case bound is given for each operation. In some cases, an amortized
--- bound is also specified; these bounds do not hold in a persistent context.
+-- bound is also specified; these bounds hold even in a persistent context.
 --
 -- This implementation is based on a binomial heap augmented with a global root.
 --
@@ -116,394 +112,5 @@ module Data.PQueue.Prio.Max (
   )
   where
 
-import Control.Applicative (liftA2)
-import Data.Maybe (fromMaybe)
 import Data.PQueue.Prio.Max.Internals
-
-#if MIN_VERSION_base(4,9,0)
-import Data.Semigroup (Semigroup((<>)))
-#endif
-
-import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null)
-import qualified Data.Foldable as F
-
-import qualified Data.PQueue.Prio.Min as Q
-
-#ifdef __GLASGOW_HASKELL__
-import Text.Read (Lexeme(Ident), lexP, parens, prec,
-  readPrec, readListPrec, readListPrecDefault)
-#else
-build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
-build f = f (:) []
-#endif
-
-first' :: (a -> b) -> (a, c) -> (b, c)
-first' f (a, c) = (f a, c)
-
-#if MIN_VERSION_base(4,9,0)
-instance Ord k => Semigroup (MaxPQueue k a) where
-  (<>) = union
-#endif
-
-instance Ord k => Monoid (MaxPQueue k a) where
-  mempty = empty
-#if !MIN_VERSION_base(4,11,0)
-  mappend = union
-#endif
-  mconcat = unions
-
-instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where
-  showsPrec p xs = showParen (p > 10) $
-    showString "fromDescList " . shows (toDescList xs)
-
-instance (Read k, Read a) => Read (MaxPQueue k a) where
-#ifdef __GLASGOW_HASKELL__
-  readPrec = parens $ prec 10 $ do
-    Ident "fromDescList" <- lexP
-    xs <- readPrec
-    return (fromDescList xs)
-
-  readListPrec = readListPrecDefault
-#else
-  readsPrec p = readParen (p > 10) $ \r -> do
-    ("fromDescList",s) <- lex r
-    (xs,t) <- reads s
-    return (fromDescList xs,t)
-#endif
-
-instance Functor (MaxPQueue k) where
-  fmap f (MaxPQ q) = MaxPQ (fmap f q)
-
-instance Ord k => Foldable (MaxPQueue k) where
-  foldr f z (MaxPQ q) = foldr f z q
-  foldl f z (MaxPQ q) = foldl f z q
-
-  length = size
-  null = null
-
--- | Traverses in descending order. 'mapM' is strictly accumulating like
--- 'mapMWithKey'.
-instance Ord k => Traversable (MaxPQueue k) where
-  traverse f (MaxPQ q) = MaxPQ <$> traverse f q
-  mapM = mapMWithKey . const
-  sequence = mapM id
-
--- | /O(1)/. Returns the empty priority queue.
-empty :: MaxPQueue k a
-empty = MaxPQ Q.empty
-
--- | /O(1)/. Constructs a singleton priority queue.
-singleton :: k -> a -> MaxPQueue k a
-singleton k a = MaxPQ (Q.singleton (Down k) a)
-
--- | Amortized /O(1)/, worst-case /O(log n)/. Inserts
--- an element with the specified key into the queue.
-insert :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a
-insert k a (MaxPQ q) = MaxPQ (Q.insert (Down k) a q)
-
--- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).
--- Insert an element with the specified key into the priority queue,
--- putting it behind elements whose key compares equal to the
--- inserted one.
-insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a
-insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q)
-
--- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union
--- of the two specified queues.
-union :: Ord k => MaxPQueue k a -> MaxPQueue k a -> MaxPQueue k a
-MaxPQ q1 `union` MaxPQ q2 = MaxPQ (q1 `Q.union` q2)
-
--- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).
-unions :: Ord k => [MaxPQueue k a] -> MaxPQueue k a
-unions qs = MaxPQ (Q.unions [q | MaxPQ q <- qs])
-
--- | /O(1)/. Checks if this priority queue is empty.
-null :: MaxPQueue k a -> Bool
-null (MaxPQ q) = Q.null q
-
--- | /O(1)/. Returns the size of this priority queue.
-size :: MaxPQueue k a -> Int
-size (MaxPQ q) = Q.size q
-
--- | /O(1)/. The maximal (key, element) in the queue. Calls 'error' if empty.
-findMax :: MaxPQueue k a -> (k, a)
-findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax
-
--- | /O(1)/. The maximal (key, element) in the queue, if the queue is nonempty.
-getMax :: MaxPQueue k a -> Maybe (k, a)
-getMax (MaxPQ q) = do
-  (Down k, a) <- Q.getMin q
-  return (k, a)
-
--- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty.
-deleteMax :: Ord k => MaxPQueue k a -> MaxPQueue k a
-deleteMax (MaxPQ q) = MaxPQ (Q.deleteMin q)
-
--- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty.
-deleteFindMax :: Ord k => MaxPQueue k a -> ((k, a), MaxPQueue k a)
-deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey
-
--- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing.
-adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a
-adjustMax = adjustMaxWithKey . const
-
--- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing.
-adjustMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a
-adjustMaxWithKey f (MaxPQ q) = MaxPQ (Q.adjustMinWithKey (f . unDown) q)
-
--- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key.
--- If the queue is empty, does nothing.
-updateMax :: Ord k => (a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a
-updateMax = updateMaxWithKey . const
-
--- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key.
--- If the queue is empty, does nothing.
-updateMaxWithKey :: Ord k => (k -> a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a
-updateMaxWithKey f (MaxPQ q) = MaxPQ (Q.updateMinWithKey (f . unDown) q)
-
--- | /O(log n)/. Retrieves the value associated with the maximum key of the queue, and the queue
--- stripped of that element, or 'Nothing' if passed an empty queue.
-maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a)
-maxView q = do
-  ((_, a), q') <- maxViewWithKey q
-  return (a, q')
-
--- | /O(log n)/. Retrieves the maximal (key, value) pair of the map, and the map stripped of that
--- element, or 'Nothing' if passed an empty map.
-maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a)
-maxViewWithKey (MaxPQ q) = do
-  ((Down k, a), q') <- Q.minViewWithKey q
-  return ((k, a), MaxPQ q')
-
--- | /O(n)/. Map a function over all values in the queue.
-map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b
-map = mapWithKey . const
-
--- | /O(n)/. Map a function over all values in the queue.
-mapWithKey :: (k -> a -> b) -> MaxPQueue k a -> MaxPQueue k b
-mapWithKey f (MaxPQ q) = MaxPQ (Q.mapWithKey (f . unDown) q)
-
--- | /O(n)/. Map a function over all values in the queue.
-mapKeys :: Ord k' => (k -> k') -> MaxPQueue k a -> MaxPQueue k' a
-mapKeys f (MaxPQ q) = MaxPQ (Q.mapKeys (fmap f) q)
-
--- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly
--- monotonic. /The precondition is not checked./  This function has better performance than
--- 'mapKeys'.
-mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a
-mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q)
-
--- | /O(n log n)/. Fold the keys and values in the map, such that
--- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@.
---
--- If you do not care about the traversal order, consider using 'foldrWithKeyU'.
-foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b
-foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q
-
--- | /O(n log n)/. Fold the keys and values in the map, such that
--- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toDescList' q)@.
---
--- If you do not care about the traversal order, consider using 'foldlWithKeyU'.
-foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b
-foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (\z -> f z . unDown) z0 q
-
--- | /O(n log n)/. Traverses the elements of the queue in descending order by key.
--- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@)
---
--- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.
---
--- If you are working in a strict monad, consider using 'mapMWithKey'.
-traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
-traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q
-
--- | A strictly accumulating version of 'traverseWithKey'. This works well in
--- 'IO' and strict @State@, and is likely what you want for other "strict" monads,
--- where @⊥ >>= pure () = ⊥@.
-mapMWithKey :: (Ord k, Monad m) => (k -> a -> m b) -> MaxPQueue k a -> m (MaxPQueue k b)
-mapMWithKey f = go empty
-  where
-    go !acc q =
-      case maxViewWithKey q of
-        Nothing           -> pure acc
-        Just ((k, a), q') -> do
-          b <- f k a
-          let !acc' = insertMin' k b acc
-          go acc' q'
-
--- | /O(k log n)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.
--- (@'take' k q == 'List.take' k ('toDescList' q)@)
-take :: Ord k => Int -> MaxPQueue k a -> [(k, a)]
-take k (MaxPQ q) = fmap (first' unDown) (Q.take k q)
-
--- | /O(k log n)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.
-drop :: Ord k => Int -> MaxPQueue k a -> MaxPQueue k a
-drop k (MaxPQ q) = MaxPQ (Q.drop k q)
-
--- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@.
-splitAt :: Ord k => Int -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
-splitAt k (MaxPQ q) = case Q.splitAt k q of
-  (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
-
--- | Takes the longest possible prefix of elements satisfying the predicate.
--- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@)
-takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)]
-takeWhile = takeWhileWithKey . const
-
--- | Takes the longest possible prefix of elements satisfying the predicate.
--- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toDescList' q)@)
-takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> [(k, a)]
-takeWhileWithKey p (MaxPQ q) = fmap (first' unDown) (Q.takeWhileWithKey (p . unDown) q)
-
--- | Removes the longest possible prefix of elements satisfying the predicate.
-dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
-dropWhile = dropWhileWithKey . const
-
--- | Removes the longest possible prefix of elements satisfying the predicate.
-dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
-dropWhileWithKey p (MaxPQ q) = MaxPQ (Q.dropWhileWithKey (p . unDown) q)
-
--- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@.
-span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
-span = spanWithKey . const
-
--- | Equivalent to @'span' ('not' . p)@.
-break :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
-break = breakWithKey . const
-
--- | Equivalent to @'spanWithKey' (\k a -> 'not' (p k a)) q@.
-spanWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
-spanWithKey p (MaxPQ q) = case Q.spanWithKey (p . unDown) q of
-  (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
-
--- | Equivalent to @'spanWithKey' (\k a -> 'not' (p k a)) q@.
-breakWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
-breakWithKey p (MaxPQ q) = case Q.breakWithKey (p . unDown) q of
-  (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
-
--- | /O(n)/. Filter all values that satisfy the predicate.
-filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
-filter = filterWithKey . const
-
--- | /O(n)/. Filter all values that satisfy the predicate.
-filterWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
-filterWithKey p (MaxPQ q) = MaxPQ (Q.filterWithKey (p . unDown) q)
-
--- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements
--- which satisfy the predicate, the second all elements that fail the predicate.
-partition :: Ord k => (a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)
-partition = partitionWithKey . const
-
--- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements
--- which satisfy the predicate, the second all elements that fail the predicate.
-partitionWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)
-partitionWithKey p (MaxPQ q) = case Q.partitionWithKey (p . unDown) q of
-  (q1, q0) -> (MaxPQ q1, MaxPQ q0)
-
--- | /O(n)/. Map values and collect the 'Just' results.
-mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b
-mapMaybe = mapMaybeWithKey . const
-
--- | /O(n)/. Map values and collect the 'Just' results.
-mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b
-mapMaybeWithKey f (MaxPQ q) = MaxPQ (Q.mapMaybeWithKey (f . unDown) q)
-
--- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
-mapEither :: Ord k => (a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)
-mapEither = mapEitherWithKey . const
-
--- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
-mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)
-mapEitherWithKey f (MaxPQ q) = case Q.mapEitherWithKey (f . unDown) q of
-  (qL, qR) -> (MaxPQ qL, MaxPQ qR)
-
--- | /O(n)/. Build a priority queue from the list of (key, value) pairs.
-fromList :: Ord k => [(k, a)] -> MaxPQueue k a
-fromList = MaxPQ . Q.fromList . fmap (first' Down)
-
--- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./
-fromAscList :: [(k, a)] -> MaxPQueue k a
-fromAscList = MaxPQ . Q.fromDescList . fmap (first' Down)
-
--- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./
-fromDescList :: [(k, a)] -> MaxPQueue k a
-fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down)
-
--- | /O(n log n)/. Return all keys of the queue in descending order.
-keys :: Ord k => MaxPQueue k a -> [k]
-keys = fmap fst . toDescList
-
--- | /O(n log n)/. Return all elements of the queue in descending order by key.
-elems :: Ord k => MaxPQueue k a -> [a]
-elems = fmap snd . toDescList
-
--- | /O(n log n)/. Equivalent to 'toDescList'.
-assocs :: Ord k => MaxPQueue k a -> [(k, a)]
-assocs = toDescList
-
--- | /O(n log n)/. Return all (key, value) pairs in ascending order by key.
-toAscList :: Ord k => MaxPQueue k a -> [(k, a)]
-toAscList (MaxPQ q) = fmap (first' unDown) (Q.toDescList q)
-
--- | /O(n log n)/. Return all (key, value) pairs in descending order by key.
-toDescList :: Ord k => MaxPQueue k a -> [(k, a)]
-toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q)
-
--- | /O(n log n)/. Equivalent to 'toDescList'.
---
--- If the traversal order is irrelevant, consider using 'toListU'.
-toList :: Ord k => MaxPQueue k a -> [(k, a)]
-toList = toDescList
-
--- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
-foldrU :: (a -> b -> b) -> b -> MaxPQueue k a -> b
-foldrU = foldrWithKeyU . const
-
--- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
-foldrWithKeyU :: (k -> a -> b -> b) -> b -> MaxPQueue k a -> b
-foldrWithKeyU f z (MaxPQ q) = Q.foldrWithKeyU (f . unDown) z q
-
--- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.
-foldlU :: (b -> a -> b) -> b -> MaxPQueue k a -> b
-foldlU f = foldlWithKeyU (const . f)
-
--- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.
-foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b
-foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\z -> f z . unDown) z0 q
-
--- | /O(n)/. An unordered traversal over a priority queue, in no particular order.
--- While there is no guarantee in which order the elements are traversed, the resulting
--- priority queue will be perfectly valid.
-traverseU :: (Applicative f) => (a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
-traverseU = traverseWithKeyU . const
-
--- | /O(n)/. An unordered traversal over a priority queue, in no particular order.
--- While there is no guarantee in which order the elements are traversed, the resulting
--- priority queue will be perfectly valid.
-traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
-traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q
-
--- | /O(n)/. Return all keys of the queue in no particular order.
-keysU :: MaxPQueue k a -> [k]
-keysU = fmap fst . toListU
-
--- | /O(n)/. Return all elements of the queue in no particular order.
-elemsU :: MaxPQueue k a -> [a]
-elemsU = fmap snd . toListU
-
--- | /O(n)/. Equivalent to 'toListU'.
-assocsU :: MaxPQueue k a -> [(k, a)]
-assocsU = toListU
-
--- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order.
-toListU :: MaxPQueue k a -> [(k, a)]
-toListU (MaxPQ q) = fmap (first' unDown) (Q.toListU q)
-
--- | /O(log n)/. @seqSpine q r@ forces the spine of @q@ and returns @r@.
---
--- Note: The spine of a 'MaxPQueue' 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, 'mapKeysMonotonic' can leave
--- expensive thunks in the structure and repeated applications of that function
--- can create thunk chains.
-seqSpine :: MaxPQueue k a -> b -> b
-seqSpine (MaxPQ q) = Q.seqSpine q
+import Prelude ()
diff --git a/src/Data/PQueue/Prio/Max/Internals.hs b/src/Data/PQueue/Prio/Max/Internals.hs
index a7caca4..2204559 100644
--- a/src/Data/PQueue/Prio/Max/Internals.hs
+++ b/src/Data/PQueue/Prio/Max/Internals.hs
@@ -1,23 +1,127 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 
-module Data.PQueue.Prio.Max.Internals where
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.PQueue.Prio.Max
+-- Copyright   :  (c) Louis Wasserman 2010
+-- License     :  BSD-style
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+-----------------------------------------------------------------------------
+module Data.PQueue.Prio.Max.Internals (
+  MaxPQueue (..),
+  -- * Construction
+  empty,
+  singleton,
+  insert,
+  insertBehind,
+  union,
+  unions,
+  -- * Query
+  null,
+  size,
+  -- ** Maximum view
+  findMax,
+  getMax,
+  deleteMax,
+  deleteFindMax,
+  adjustMax,
+  adjustMaxWithKey,
+  updateMax,
+  updateMaxWithKey,
+  maxView,
+  maxViewWithKey,
+  -- * Traversal
+  -- ** Map
+  map,
+  mapWithKey,
+  mapKeys,
+  mapKeysMonotonic,
+  -- ** Fold
+  foldrWithKey,
+  foldlWithKey,
+  -- ** Traverse
+  traverseWithKey,
+  mapMWithKey,
+  -- * Subsets
+  -- ** Indexed
+  take,
+  drop,
+  splitAt,
+  -- ** Predicates
+  takeWhile,
+  takeWhileWithKey,
+  dropWhile,
+  dropWhileWithKey,
+  span,
+  spanWithKey,
+  break,
+  breakWithKey,
+  -- *** Filter
+  filter,
+  filterWithKey,
+  partition,
+  partitionWithKey,
+  mapMaybe,
+  mapMaybeWithKey,
+  mapEither,
+  mapEitherWithKey,
+  -- * List operations
+  -- ** Conversion from lists
+  fromList,
+  fromAscList,
+  fromDescList,
+  -- ** Conversion to lists
+  keys,
+  elems,
+  assocs,
+  toAscList,
+  toDescList,
+  toList,
+  -- * Unordered operations
+  foldrU,
+  foldrWithKeyU,
+  foldlU,
+  foldlWithKeyU,
+  traverseU,
+  traverseWithKeyU,
+  keysU,
+  elemsU,
+  assocsU,
+  toListU,
+  -- * Helper methods
+  seqSpine
+  )
+  where
 
+import Data.Maybe (fromMaybe)
+import Data.PQueue.Internals.Down
+import Data.PQueue.Prio.Internals (MinPQueue)
+import qualified Data.PQueue.Prio.Internals as PrioInternals
 import Control.DeepSeq (NFData(rnf))
 
-#if __GLASGOW_HASKELL__
-import Data.Data (Data)
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>)))
 #endif
 
-import Data.PQueue.Prio.Internals (MinPQueue)
-import qualified Data.PQueue.Prio.Internals as Internals
+import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt, take, drop, (!!), null)
+import qualified Data.Foldable as F
 
-newtype Down a = Down { unDown :: a }
-# if __GLASGOW_HASKELL__
-  deriving (Eq, Data)
-# else
-  deriving (Eq)
-# endif
+import qualified Data.PQueue.Prio.Min as Q
 
+#ifdef __GLASGOW_HASKELL__
+import Data.Data (Data)
+import Text.Read (Lexeme(Ident), lexP, parens, prec,
+  readPrec, readListPrec, readListPrecDefault)
+#endif
+
+
+#ifndef __GLASGOW_HASKELL__
+build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
+build f = f (:) []
+#endif
 
 -- | A priority queue where values of type @a@ are annotated with keys of type @k@.
 -- The queue supports extracting the element with maximum key.
@@ -31,22 +135,376 @@ newtype MaxPQueue k a = MaxPQ (MinPQueue (Down k) a)
 instance (NFData k, NFData a) => NFData (MaxPQueue k a) where
   rnf (MaxPQ q) = rnf q
 
-instance NFData a => NFData (Down a) where
-  rnf (Down a) = rnf a
+first' :: (a -> b) -> (a, c) -> (b, c)
+first' f (a, c) = (f a, c)
+
+#if MIN_VERSION_base(4,9,0)
+instance Ord k => Semigroup (MaxPQueue k a) where
+  (<>) = union
+#endif
+
+instance Ord k => Monoid (MaxPQueue k a) where
+  mempty = empty
+#if !MIN_VERSION_base(4,11,0)
+  mappend = union
+#endif
+  mconcat = unions
+
+instance (Ord k, Show k, Show a) => Show (MaxPQueue k a) where
+  showsPrec p xs = showParen (p > 10) $
+    showString "fromDescList " . shows (toDescList xs)
+
+instance (Read k, Read a) => Read (MaxPQueue k a) where
+#ifdef __GLASGOW_HASKELL__
+  readPrec = parens $ prec 10 $ do
+    Ident "fromDescList" <- lexP
+    xs <- readPrec
+    return (fromDescList xs)
+
+  readListPrec = readListPrecDefault
+#else
+  readsPrec p = readParen (p > 10) $ \r -> do
+    ("fromDescList",s) <- lex r
+    (xs,t) <- reads s
+    return (fromDescList xs,t)
+#endif
+
+instance Functor (MaxPQueue k) where
+  fmap f (MaxPQ q) = MaxPQ (fmap f q)
+
+instance Ord k => Foldable (MaxPQueue k) where
+  foldr f z (MaxPQ q) = foldr f z q
+  foldl f z (MaxPQ q) = foldl f z q
+
+  length = size
+  null = null
+
+-- | Traverses in descending order. 'mapM' is strictly accumulating like
+-- 'mapMWithKey'.
+instance Ord k => Traversable (MaxPQueue k) where
+  traverse f (MaxPQ q) = MaxPQ <$> traverse f q
+  mapM = mapMWithKey . const
+  sequence = mapM id
+
+-- | /O(1)/. Returns the empty priority queue.
+empty :: MaxPQueue k a
+empty = MaxPQ Q.empty
+
+-- | /O(1)/. Constructs a singleton priority queue.
+singleton :: k -> a -> MaxPQueue k a
+singleton k a = MaxPQ (Q.singleton (Down k) a)
+
+-- | Amortized /O(1)/, worst-case /O(log n)/. Inserts
+-- an element with the specified key into the queue.
+insert :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a
+insert k a (MaxPQ q) = MaxPQ (Q.insert (Down k) a q)
+
+-- | /O(n)/ (an earlier implementation had /O(1)/ but was buggy).
+-- Insert an element with the specified key into the priority queue,
+-- putting it behind elements whose key compares equal to the
+-- inserted one.
+insertBehind :: Ord k => k -> a -> MaxPQueue k a -> MaxPQueue k a
+insertBehind k a (MaxPQ q) = MaxPQ (Q.insertBehind (Down k) a q)
+
+-- | Amortized /O(log(min(n1, n2)))/, worst-case /O(log(max(n1, n2)))/. Returns the union
+-- of the two specified queues.
+union :: Ord k => MaxPQueue k a -> MaxPQueue k a -> MaxPQueue k a
+MaxPQ q1 `union` MaxPQ q2 = MaxPQ (q1 `Q.union` q2)
+
+-- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).
+unions :: Ord k => [MaxPQueue k a] -> MaxPQueue k a
+unions qs = MaxPQ (Q.unions [q | MaxPQ q <- qs])
+
+-- | /O(1)/. Checks if this priority queue is empty.
+null :: MaxPQueue k a -> Bool
+null (MaxPQ q) = Q.null q
+
+-- | /O(1)/. Returns the size of this priority queue.
+size :: MaxPQueue k a -> Int
+size (MaxPQ q) = Q.size q
+
+-- | /O(1)/. The maximal (key, element) in the queue. Calls 'error' if empty.
+findMax :: MaxPQueue k a -> (k, a)
+findMax = fromMaybe (error "Error: findMax called on an empty queue") . getMax
+
+-- | /O(1)/. The maximal (key, element) in the queue, if the queue is nonempty.
+getMax :: MaxPQueue k a -> Maybe (k, a)
+getMax (MaxPQ q) = do
+  (Down k, a) <- Q.getMin q
+  return (k, a)
+
+-- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty.
+deleteMax :: Ord k => MaxPQueue k a -> MaxPQueue k a
+deleteMax (MaxPQ q) = MaxPQ (Q.deleteMin q)
+
+-- | /O(log n)/. Delete and find the element with the maximum key. Calls 'error' if empty.
+deleteFindMax :: Ord k => MaxPQueue k a -> ((k, a), MaxPQueue k a)
+deleteFindMax = fromMaybe (error "Error: deleteFindMax called on an empty queue") . maxViewWithKey
+
+-- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing.
+adjustMax :: (a -> a) -> MaxPQueue k a -> MaxPQueue k a
+adjustMax = adjustMaxWithKey . const
+
+-- | /O(1)/. Alter the value at the maximum key. If the queue is empty, does nothing.
+adjustMaxWithKey :: (k -> a -> a) -> MaxPQueue k a -> MaxPQueue k a
+adjustMaxWithKey f (MaxPQ q) = MaxPQ (Q.adjustMinWithKey (f . unDown) q)
+
+-- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key.
+-- If the queue is empty, does nothing.
+updateMax :: Ord k => (a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a
+updateMax = updateMaxWithKey . const
+
+-- | /O(log n)/. (Actually /O(1)/ if there's no deletion.) Update the value at the maximum key.
+-- If the queue is empty, does nothing.
+updateMaxWithKey :: Ord k => (k -> a -> Maybe a) -> MaxPQueue k a -> MaxPQueue k a
+updateMaxWithKey f (MaxPQ q) = MaxPQ (Q.updateMinWithKey (f . unDown) q)
+
+-- | /O(log n)/. Retrieves the value associated with the maximum key of the queue, and the queue
+-- stripped of that element, or 'Nothing' if passed an empty queue.
+maxView :: Ord k => MaxPQueue k a -> Maybe (a, MaxPQueue k a)
+maxView q = do
+  ((_, a), q') <- maxViewWithKey q
+  return (a, q')
+
+-- | /O(log n)/. Retrieves the maximal (key, value) pair of the map, and the map stripped of that
+-- element, or 'Nothing' if passed an empty map.
+maxViewWithKey :: Ord k => MaxPQueue k a -> Maybe ((k, a), MaxPQueue k a)
+maxViewWithKey (MaxPQ q) = do
+  ((Down k, a), q') <- Q.minViewWithKey q
+  return ((k, a), MaxPQ q')
+
+-- | /O(n)/. Map a function over all values in the queue.
+map :: (a -> b) -> MaxPQueue k a -> MaxPQueue k b
+map = mapWithKey . const
 
-instance Ord a => Ord (Down a) where
-  Down a `compare` Down b = b `compare` a
-  Down a <= Down b = b <= a
+-- | /O(n)/. Map a function over all values in the queue.
+mapWithKey :: (k -> a -> b) -> MaxPQueue k a -> MaxPQueue k b
+mapWithKey f (MaxPQ q) = MaxPQ (Q.mapWithKey (f . unDown) q)
 
-instance Functor Down where
-  fmap f (Down a) = Down (f a)
+-- | /O(n)/. Map a function over all values in the queue.
+mapKeys :: Ord k' => (k -> k') -> MaxPQueue k a -> MaxPQueue k' a
+mapKeys f (MaxPQ q) = MaxPQ (Q.mapKeys (fmap f) q)
 
-instance Foldable Down where
-  foldr f z (Down a) = a `f` z
-  foldl f z (Down a) = z `f` a
+-- | /O(n)/. @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when @f@ is strictly
+-- monotonic. /The precondition is not checked./  This function has better performance than
+-- 'mapKeys'.
+mapKeysMonotonic :: (k -> k') -> MaxPQueue k a -> MaxPQueue k' a
+mapKeysMonotonic f (MaxPQ q) = MaxPQ (Q.mapKeysMonotonic (fmap f) q)
 
-instance Traversable Down where
-  traverse f (Down a) = Down <$> f a
+-- | /O(n log n)/. Fold the keys and values in the map, such that
+-- @'foldrWithKey' f z q == 'List.foldr' ('uncurry' f) z ('toDescList' q)@.
+--
+-- If you do not care about the traversal order, consider using 'foldrWithKeyU'.
+foldrWithKey :: Ord k => (k -> a -> b -> b) -> b -> MaxPQueue k a -> b
+foldrWithKey f z (MaxPQ q) = Q.foldrWithKey (f . unDown) z q
+
+-- | /O(n log n)/. Fold the keys and values in the map, such that
+-- @'foldlWithKey' f z q == 'List.foldl' ('uncurry' . f) z ('toDescList' q)@.
+--
+-- If you do not care about the traversal order, consider using 'foldlWithKeyU'.
+foldlWithKey :: Ord k => (b -> k -> a -> b) -> b -> MaxPQueue k a -> b
+foldlWithKey f z0 (MaxPQ q) = Q.foldlWithKey (\z -> f z . unDown) z0 q
+
+-- | /O(n log n)/. Traverses the elements of the queue in descending order by key.
+-- (@'traverseWithKey' f q == 'fromDescList' <$> 'traverse' ('uncurry' f) ('toDescList' q)@)
+--
+-- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.
+--
+-- If you are working in a strict monad, consider using 'mapMWithKey'.
+traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
+traverseWithKey f (MaxPQ q) = MaxPQ <$> Q.traverseWithKey (f . unDown) q
+
+-- | A strictly accumulating version of 'traverseWithKey'. This works well in
+-- 'IO' and strict @State@, and is likely what you want for other "strict" monads,
+-- where @⊥ >>= pure () = ⊥@.
+mapMWithKey :: (Ord k, Monad m) => (k -> a -> m b) -> MaxPQueue k a -> m (MaxPQueue k b)
+mapMWithKey f = go empty
+  where
+    go !acc q =
+      case maxViewWithKey q of
+        Nothing           -> pure acc
+        Just ((k, a), q') -> do
+          b <- f k a
+          let !acc' = insertMin' k b acc
+          go acc' q'
 
 insertMin' :: k -> a -> MaxPQueue k a -> MaxPQueue k a
-insertMin' k a (MaxPQ q) = MaxPQ (Internals.insertMax' (Down k) a q)
+insertMin' k a (MaxPQ q) = MaxPQ (PrioInternals.insertMax' (Down k) a q)
+
+-- | /O(k log n)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.
+-- (@'take' k q == 'List.take' k ('toDescList' q)@)
+take :: Ord k => Int -> MaxPQueue k a -> [(k, a)]
+take k (MaxPQ q) = fmap (first' unDown) (Q.take k q)
+
+-- | /O(k log n)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.
+drop :: Ord k => Int -> MaxPQueue k a -> MaxPQueue k a
+drop k (MaxPQ q) = MaxPQ (Q.drop k q)
+
+-- | /O(k log n)/. Equivalent to @('take' k q, 'drop' k q)@.
+splitAt :: Ord k => Int -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
+splitAt k (MaxPQ q) = case Q.splitAt k q of
+  (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
+
+-- | Takes the longest possible prefix of elements satisfying the predicate.
+-- (@'takeWhile' p q == 'List.takeWhile' (p . 'snd') ('toDescList' q)@)
+takeWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> [(k, a)]
+takeWhile = takeWhileWithKey . const
+
+-- | Takes the longest possible prefix of elements satisfying the predicate.
+-- (@'takeWhile' p q == 'List.takeWhile' (uncurry p) ('toDescList' q)@)
+takeWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> [(k, a)]
+takeWhileWithKey p (MaxPQ q) = fmap (first' unDown) (Q.takeWhileWithKey (p . unDown) q)
+
+-- | Removes the longest possible prefix of elements satisfying the predicate.
+dropWhile :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
+dropWhile = dropWhileWithKey . const
+
+-- | Removes the longest possible prefix of elements satisfying the predicate.
+dropWhileWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
+dropWhileWithKey p (MaxPQ q) = MaxPQ (Q.dropWhileWithKey (p . unDown) q)
+
+-- | Equivalent to @('takeWhile' p q, 'dropWhile' p q)@.
+span :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
+span = spanWithKey . const
+
+-- | Equivalent to @'span' ('not' . p)@.
+break :: Ord k => (a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
+break = breakWithKey . const
+
+-- | Equivalent to @'spanWithKey' (\k a -> 'not' (p k a)) q@.
+spanWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
+spanWithKey p (MaxPQ q) = case Q.spanWithKey (p . unDown) q of
+  (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
+
+-- | Equivalent to @'spanWithKey' (\k a -> 'not' (p k a)) q@.
+breakWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
+breakWithKey p (MaxPQ q) = case Q.breakWithKey (p . unDown) q of
+  (xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
+
+-- | /O(n)/. Filter all values that satisfy the predicate.
+filter :: Ord k => (a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
+filter = filterWithKey . const
+
+-- | /O(n)/. Filter all values that satisfy the predicate.
+filterWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> MaxPQueue k a
+filterWithKey p (MaxPQ q) = MaxPQ (Q.filterWithKey (p . unDown) q)
+
+-- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements
+-- which satisfy the predicate, the second all elements that fail the predicate.
+partition :: Ord k => (a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)
+partition = partitionWithKey . const
+
+-- | /O(n)/. Partition the queue according to a predicate. The first queue contains all elements
+-- which satisfy the predicate, the second all elements that fail the predicate.
+partitionWithKey :: Ord k => (k -> a -> Bool) -> MaxPQueue k a -> (MaxPQueue k a, MaxPQueue k a)
+partitionWithKey p (MaxPQ q) = case Q.partitionWithKey (p . unDown) q of
+  (q1, q0) -> (MaxPQ q1, MaxPQ q0)
+
+-- | /O(n)/. Map values and collect the 'Just' results.
+mapMaybe :: Ord k => (a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b
+mapMaybe = mapMaybeWithKey . const
+
+-- | /O(n)/. Map values and collect the 'Just' results.
+mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> MaxPQueue k a -> MaxPQueue k b
+mapMaybeWithKey f (MaxPQ q) = MaxPQ (Q.mapMaybeWithKey (f . unDown) q)
+
+-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
+mapEither :: Ord k => (a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)
+mapEither = mapEitherWithKey . const
+
+-- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
+mapEitherWithKey :: Ord k => (k -> a -> Either b c) -> MaxPQueue k a -> (MaxPQueue k b, MaxPQueue k c)
+mapEitherWithKey f (MaxPQ q) = case Q.mapEitherWithKey (f . unDown) q of
+  (qL, qR) -> (MaxPQ qL, MaxPQ qR)
+
+-- | /O(n)/. Build a priority queue from the list of (key, value) pairs.
+fromList :: Ord k => [(k, a)] -> MaxPQueue k a
+fromList = MaxPQ . Q.fromList . fmap (first' Down)
+
+-- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./
+fromAscList :: [(k, a)] -> MaxPQueue k a
+fromAscList = MaxPQ . Q.fromDescList . fmap (first' Down)
+
+-- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./
+fromDescList :: [(k, a)] -> MaxPQueue k a
+fromDescList = MaxPQ . Q.fromAscList . fmap (first' Down)
+
+-- | /O(n log n)/. Return all keys of the queue in descending order.
+keys :: Ord k => MaxPQueue k a -> [k]
+keys = fmap fst . toDescList
+
+-- | /O(n log n)/. Return all elements of the queue in descending order by key.
+elems :: Ord k => MaxPQueue k a -> [a]
+elems = fmap snd . toDescList
+
+-- | /O(n log n)/. Equivalent to 'toDescList'.
+assocs :: Ord k => MaxPQueue k a -> [(k, a)]
+assocs = toDescList
+
+-- | /O(n log n)/. Return all (key, value) pairs in ascending order by key.
+toAscList :: Ord k => MaxPQueue k a -> [(k, a)]
+toAscList (MaxPQ q) = fmap (first' unDown) (Q.toDescList q)
+
+-- | /O(n log n)/. Return all (key, value) pairs in descending order by key.
+toDescList :: Ord k => MaxPQueue k a -> [(k, a)]
+toDescList (MaxPQ q) = fmap (first' unDown) (Q.toAscList q)
+
+-- | /O(n log n)/. Equivalent to 'toDescList'.
+--
+-- If the traversal order is irrelevant, consider using 'toListU'.
+toList :: Ord k => MaxPQueue k a -> [(k, a)]
+toList = toDescList
+
+-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
+foldrU :: (a -> b -> b) -> b -> MaxPQueue k a -> b
+foldrU = foldrWithKeyU . const
+
+-- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
+foldrWithKeyU :: (k -> a -> b -> b) -> b -> MaxPQueue k a -> b
+foldrWithKeyU f z (MaxPQ q) = Q.foldrWithKeyU (f . unDown) z q
+
+-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.
+foldlU :: (b -> a -> b) -> b -> MaxPQueue k a -> b
+foldlU f = foldlWithKeyU (const . f)
+
+-- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.
+foldlWithKeyU :: (b -> k -> a -> b) -> b -> MaxPQueue k a -> b
+foldlWithKeyU f z0 (MaxPQ q) = Q.foldlWithKeyU (\z -> f z . unDown) z0 q
+
+-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.
+-- While there is no guarantee in which order the elements are traversed, the resulting
+-- priority queue will be perfectly valid.
+traverseU :: (Applicative f) => (a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
+traverseU = traverseWithKeyU . const
+
+-- | /O(n)/. An unordered traversal over a priority queue, in no particular order.
+-- While there is no guarantee in which order the elements are traversed, the resulting
+-- priority queue will be perfectly valid.
+traverseWithKeyU :: (Applicative f) => (k -> a -> f b) -> MaxPQueue k a -> f (MaxPQueue k b)
+traverseWithKeyU f (MaxPQ q) = MaxPQ <$> Q.traverseWithKeyU (f . unDown) q
+
+-- | /O(n)/. Return all keys of the queue in no particular order.
+keysU :: MaxPQueue k a -> [k]
+keysU = fmap fst . toListU
+
+-- | /O(n)/. Return all elements of the queue in no particular order.
+elemsU :: MaxPQueue k a -> [a]
+elemsU = fmap snd . toListU
+
+-- | /O(n)/. Equivalent to 'toListU'.
+assocsU :: MaxPQueue k a -> [(k, a)]
+assocsU = toListU
+
+-- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order.
+toListU :: MaxPQueue k a -> [(k, a)]
+toListU (MaxPQ q) = fmap (first' unDown) (Q.toListU q)
+
+-- | /O(log n)/. @seqSpine q r@ forces the spine of @q@ and returns @r@.
+--
+-- Note: The spine of a 'MaxPQueue' 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, 'mapKeysMonotonic' can leave
+-- expensive thunks in the structure and repeated applications of that function
+-- can create thunk chains.
+seqSpine :: MaxPQueue k a -> b -> b
+seqSpine (MaxPQ q) = Q.seqSpine q
diff --git a/src/Data/PQueue/Prio/Min.hs b/src/Data/PQueue/Prio/Min.hs
index 75c0ea7..b81251d 100644
--- a/src/Data/PQueue/Prio/Min.hs
+++ b/src/Data/PQueue/Prio/Min.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -16,7 +15,7 @@
 -- viewing and extracting the element with the minimum key.
 --
 -- A worst-case bound is given for each operation. In some cases, an amortized
--- bound is also specified; these bounds do not hold in a persistent context.
+-- bound is also specified; these bounds hold even in a persistent context.
 --
 -- This implementation is based on a binomial heap augmented with a global root.
 --
@@ -116,7 +115,6 @@ module Data.PQueue.Prio.Min (
   )
   where
 
-import Control.Applicative (liftA2)
 import qualified Data.List as List
 import Data.Maybe (fromMaybe)
 
@@ -130,8 +128,6 @@ import Prelude hiding (map, filter, break, span, takeWhile, dropWhile, splitAt,
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
-import Text.Read (Lexeme(Ident), lexP, parens, prec,
-  readPrec, readListPrec, readListPrecDefault)
 #else
 build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
 build f = f (:) []
@@ -145,42 +141,6 @@ uncurry' f (a, b) = f a b
 
 infixr 8 .:
 
-#if MIN_VERSION_base(4,9,0)
-instance Ord k => Semigroup (MinPQueue k a) where
-  (<>) = union
-#endif
-
-instance Ord k => Monoid (MinPQueue k a) where
-  mempty = empty
-#if !MIN_VERSION_base(4,11,0)
-  mappend = union
-#endif
-  mconcat = unions
-
-instance (Ord k, Show k, Show a) => Show (MinPQueue k a) where
-  showsPrec p xs = showParen (p > 10) $
-    showString "fromAscList " . shows (toAscList xs)
-
-instance (Read k, Read a) => Read (MinPQueue k a) where
-#ifdef __GLASGOW_HASKELL__
-  readPrec = parens $ prec 10 $ do
-    Ident "fromAscList" <- lexP
-    xs <- readPrec
-    return (fromAscList xs)
-
-  readListPrec = readListPrecDefault
-#else
-  readsPrec p = readParen (p > 10) $ \r -> do
-    ("fromAscList",s) <- lex r
-    (xs,t) <- reads s
-    return (fromAscList xs,t)
-#endif
-
-
--- | The union of a list of queues: (@'unions' == 'List.foldl' 'union' 'empty'@).
-unions :: Ord k => [MinPQueue k a] -> MinPQueue k a
-unions = List.foldl' union empty
-
 -- | /O(1)/. The minimal (key, element) in the queue. Calls 'error' if empty.
 findMin :: MinPQueue k a -> (k, a)
 findMin = fromMaybe (error "Error: findMin called on an empty queue") . getMin
@@ -217,31 +177,6 @@ map = mapWithKey . const
 mapKeys :: Ord k' => (k -> k') -> MinPQueue k a -> MinPQueue k' a
 mapKeys f q = fromList [(f k, a) | (k, a) <- toListU q]
 
--- | /O(n log n)/. Traverses the elements of the queue in ascending order by key.
--- (@'traverseWithKey' f q == 'fromAscList' <$> 'traverse' ('uncurry' f) ('toAscList' q)@)
---
--- If you do not care about the /order/ of the traversal, consider using 'traverseWithKeyU'.
---
--- If you are working in a strict monad, consider using 'mapMWithKey'.
-traverseWithKey :: (Ord k, Applicative f) => (k -> a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
-traverseWithKey f q = case minViewWithKey q of
-  Nothing      -> pure empty
-  Just ((k, a), q')  -> liftA2 (insertMin k) (f k a) (traverseWithKey f q')
-
--- | A strictly accumulating version of 'traverseWithKey'. This works well in
--- 'IO' and strict @State@, and is likely what you want for other "strict" monads,
--- where @⊥ >>= pure () = ⊥@.
-mapMWithKey :: (Ord k, Monad m) => (k -> a -> m b) -> MinPQueue k a -> m (MinPQueue k b)
-mapMWithKey f = go empty
-  where
-    go !acc q =
-      case minViewWithKey q of
-        Nothing           -> pure acc
-        Just ((k, a), q') -> do
-          b <- f k a
-          let !acc' = insertMax' k b acc
-          go acc' q'
-
 -- | /O(n)/. Map values and collect the 'Just' results.
 mapMaybe :: Ord k => (a -> Maybe b) -> MinPQueue k a -> MinPQueue k b
 mapMaybe = mapMaybeWithKey . const
@@ -336,11 +271,6 @@ spanWithKey p q = case minViewWithKey q of
 breakWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
 breakWithKey p = spanWithKey (not .: p)
 
--- | /O(n)/. Build a priority queue from an ascending list of (key, value) pairs. /The precondition is not checked./
-fromAscList :: [(k, a)] -> MinPQueue k a
-{-# INLINE fromAscList #-}
-fromAscList xs = List.foldl' (\q (k, a) -> insertMax' k a q) empty xs
-
 -- | /O(n)/. Build a priority queue from a descending list of (key, value) pairs. /The precondition is not checked./
 fromDescList :: [(k, a)] -> MinPQueue k a
 {-# INLINE fromDescList #-}
@@ -356,22 +286,6 @@ keys = List.map fst . toAscList
 elems :: Ord k => MinPQueue k a -> [a]
 elems = List.map snd . toAscList
 
-{-# INLINABLE [1] toAscList #-}
--- | /O(n log n)/. Return all (key, value) pairs in ascending order by key.
-toAscList :: Ord k => MinPQueue k a -> [(k, a)]
-toAscList = foldrWithKey (curry (:)) []
-
-{-# INLINABLE [1] toDescList #-}
--- | /O(n log n)/. Return all (key, value) pairs in descending order by key.
-toDescList :: Ord k => MinPQueue k a -> [(k, a)]
-toDescList = foldlWithKey (\z k a -> (k, a) : z) []
-
-{-# RULES
-  "toAscList" toAscList = \q -> build (\c n -> foldrWithKey (curry c) n q);
-  "toDescList" toDescList = \q -> build (\c n -> foldlWithKey (\z k a -> (k, a) `c` z) n q);
-  "toListU" toListU = \q -> build (\c n -> foldrWithKeyU (curry c) n q);
-  #-}
-
 {-# INLINE toList #-}
 -- | /O(n log n)/. Equivalent to 'toAscList'.
 --
@@ -399,15 +313,6 @@ elemsU = List.map snd . toListU
 assocsU :: MinPQueue k a -> [(k, a)]
 assocsU = toListU
 
-{-# NOINLINE toListU #-}
--- | /O(n)/. Returns all (key, value) pairs in the queue in no particular order.
-toListU :: MinPQueue k a -> [(k, a)]
-toListU = foldrWithKeyU (curry (:)) []
-
--- | /O(n)/. An unordered right fold over the elements of the queue, in no particular order.
-foldrU :: (a -> b -> b) -> b -> MinPQueue k a -> b
-foldrU = foldrWithKeyU . const
-
 -- | /O(n)/. An unordered left fold over the elements of the queue, in no particular order.
 foldlU :: (b -> a -> b) -> b -> MinPQueue k a -> b
 foldlU f = foldlWithKeyU (const . f)
@@ -417,19 +322,3 @@ foldlU f = foldlWithKeyU (const . f)
 -- priority queue will be perfectly valid.
 traverseU :: (Applicative f) => (a -> f b) -> MinPQueue k a -> f (MinPQueue k b)
 traverseU = traverseWithKeyU . const
-
-instance Functor (MinPQueue k) where
-  fmap = map
-
-instance Ord k => Foldable (MinPQueue k) where
-  foldr   = foldrWithKey . const
-  foldl f = foldlWithKey (const . f)
-  length = size
-  null = null
-
--- | Traverses in ascending order. 'mapM' is strictly accumulating like
--- 'mapMWithKey'.
-instance Ord k => Traversable (MinPQueue k) where
-  traverse = traverseWithKey . const
-  mapM = mapMWithKey . const
-  sequence = mapM id