5 files changed, 173 insertions, 0 deletions

diff --git a/minmax-psq/CHANGELOG.md b/minmax-psq/CHANGELOG.md
new file mode 100644
index 00000000..ba7d08da
--- /dev/null
+++ b/minmax-psq/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for minmax-psq
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/minmax-psq/LICENSE b/minmax-psq/LICENSE
new file mode 100644
index 00000000..e8eaef49
--- /dev/null
+++ b/minmax-psq/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, James Crayne
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of James Crayne nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/minmax-psq/Setup.hs b/minmax-psq/Setup.hs
new file mode 100644
index 00000000..9a994af6
--- /dev/null
+++ b/minmax-psq/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/minmax-psq/minmax-psq.cabal b/minmax-psq/minmax-psq.cabal
new file mode 100644
index 00000000..ba04bd45
--- /dev/null
+++ b/minmax-psq/minmax-psq.cabal
@@ -0,0 +1,24 @@
+-- Initial minmax-psq.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                minmax-psq
+version:             0.1.0.0
+-- synopsis:
+-- description:
+license:             BSD3
+license-file:        LICENSE
+author:              James Crayne
+maintainer:          jim.crayne@gmail.com
+-- copyright:
+-- category:
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Data.MinMaxPSQ
+  -- other-modules:
+  other-extensions:    BangPatterns, PatternSynonyms
+  build-depends:       base, psq-wrap
+  hs-source-dirs:      src
+  default-language:    Haskell2010
diff --git a/minmax-psq/src/Data/MinMaxPSQ.hs b/minmax-psq/src/Data/MinMaxPSQ.hs
new file mode 100644
index 00000000..e7d7c760
--- /dev/null
+++ b/minmax-psq/src/Data/MinMaxPSQ.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE BangPatterns, PatternSynonyms #-}
+module Data.MinMaxPSQ
+    ( module Data.MinMaxPSQ
+    , Binding'
+    , pattern Binding
+    ) where
+
+import Data.Ord
+import qualified Data.Wrapper.PSQ as PSQ
+         ;import Data.Wrapper.PSQ as PSQ hiding (insert, insert', null, size)
+import Prelude hiding (null, take)
+
+data MinMaxPSQ' k p v = MinMaxPSQ !Int !(PSQ' k p v) !(PSQ' k (Down p) v)
+type MinMaxPSQ k p = MinMaxPSQ' k p ()
+
+empty :: MinMaxPSQ' k p v
+empty = MinMaxPSQ 0 PSQ.empty PSQ.empty
+
+singleton' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v
+singleton' k v p = MinMaxPSQ 1 (PSQ.singleton' k v p) (PSQ.singleton' k v (Down p))
+
+null :: MinMaxPSQ' k p v -> Bool
+null (MinMaxPSQ sz _ _) = sz==0
+{-# INLINE null #-}
+
+size :: MinMaxPSQ' k p v -> Int
+size (MinMaxPSQ sz _ _) = sz
+{-# INLINE size #-}
+
+toList :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> [Binding' k p v]
+toList (MinMaxPSQ _ nq xq) = PSQ.toList nq
+
+fromList :: (PSQKey k, Ord p) => [Binding' k p v] -> MinMaxPSQ' k p v
+fromList kps = let nq = PSQ.fromList kps
+                   xq = PSQ.fromList $ map (\(Binding k v p) -> Binding k v (Down p)) kps
+               in MinMaxPSQ (PSQ.size nq) nq xq
+
+findMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v)
+findMin (MinMaxPSQ _ nq xq) = PSQ.findMin nq
+
+findMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v)
+findMax (MinMaxPSQ _ nq xq) = fmap (\(Binding k v (Down p)) -> Binding k v p) $ PSQ.findMin xq
+
+insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
+insert k p (MinMaxPSQ sz nq xq) = case PSQ.insertView k p () nq of
+    (Just _ ,nq') -> MinMaxPSQ sz     nq' (PSQ.insert k (Down p) xq)
+    (Nothing,nq') -> MinMaxPSQ (sz+1) nq' (PSQ.insert k (Down p) xq)
+
+insert' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
+insert' k v p (MinMaxPSQ sz nq xq) = case PSQ.insertView k p v nq of
+    (Just _ ,nq') -> MinMaxPSQ sz     nq' (PSQ.insert' k v (Down p) xq)
+    (Nothing,nq') -> MinMaxPSQ (sz+1) nq' (PSQ.insert' k v (Down p) xq)
+
+delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
+delete k q@(MinMaxPSQ sz nq xq) = case PSQ.deleteView k nq of
+    Just (_,_,nq') -> MinMaxPSQ (sz - 1) nq' (PSQ.delete k xq)
+    Nothing        -> q
+
+deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v
+deleteMin q@(MinMaxPSQ sz nq xq) = case PSQ.minView nq of
+    Just (Binding k _ _, nq') -> MinMaxPSQ (sz - 1) nq' (PSQ.delete k xq)
+    Nothing                   -> q
+
+deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v
+deleteMax q@(MinMaxPSQ sz nq xq) = case PSQ.minView xq of
+    Just (Binding k _ _, xq') -> MinMaxPSQ (sz - 1) (PSQ.delete k nq) xq'
+    Nothing                   -> q
+
+minView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v)
+minView (MinMaxPSQ sz nq xq) = fmap (\(Binding k v p, nq') -> (Binding k v p, MinMaxPSQ (sz-1) nq' (PSQ.delete k xq)))
+                               $ PSQ.minView nq
+
+maxView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v)
+maxView (MinMaxPSQ sz nq xq) = fmap (\(Binding k v (Down p), xq') -> (Binding k v p, MinMaxPSQ (sz-1) (PSQ.delete k nq) xq'))
+                               $ PSQ.minView xq
+
+-- | Maintains a bounded 'MinMaxPSQ' by deleting the maximum element if the
+-- insertion would cause the queue to have too many elements.
+insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
+insertTake n k p q
+    | size q <  n  = insert k p q
+    | size q == n  = insert k p $ deleteMax q
+    | otherwise    = take n $ insert k p q
+
+-- | Maintains a bounded 'MinMaxPSQ\'' by deleting the maximum element if the
+-- insertion would cause the queue to have too many elements.
+insertTake' :: (PSQKey k, Ord p) => Int -> k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
+insertTake' n k v p q
+    | size q <  n  = insert' k v p q
+    | size q == n  = insert' k v p $ deleteMax q
+    | otherwise    = take n $ insert' k v p q
+
+
+-- | Truncate the 'MinMaxPSQ' to the given number of lowest priority elements.
+take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v
+take !n !q | (size q <= n) = q
+           | null q        = q
+           | otherwise     = take n $ deleteMax q
+
+-- | Like 'take', except it provides a list deleted bindings.
+takeView :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> ( [Binding' k p v], MinMaxPSQ' k p v )
+takeView !n !q | (size q <= n) = ([], q)
+               | null q        = ([], q)
+               | otherwise     = let Just (x,q') = maxView q
+                                     (xs,q'')    = takeView n q'
+                                     ys          = x:xs
+                                 in (ys, ys `seq` q'')
+
+
+
+lookup' :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> Maybe (p, v)
+lookup' k (MinMaxPSQ _ q _) = PSQ.lookup k q