Hello community,
here is the log from the commit of package ghc-psqueues for openSUSE:Factory checked in at 2017-07-21 22:48:35
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-psqueues (Old)
and /work/SRC/openSUSE:Factory/.ghc-psqueues.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-psqueues"
Fri Jul 21 22:48:35 2017 rev:7 rq:511313 version:0.2.3.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-psqueues/ghc-psqueues.changes 2017-01-12 15:51:52.537064187 +0100
+++ /work/SRC/openSUSE:Factory/.ghc-psqueues.new/ghc-psqueues.changes 2017-07-21 22:48:39.159047344 +0200
@@ -1,0 +2,5 @@
+Tue Jul 11 03:02:31 UTC 2017 - psimons@suse.com
+
+- Update to version 0.2.3.0.
+
+-------------------------------------------------------------------
Old:
----
psqueues-0.2.2.3.tar.gz
New:
----
psqueues-0.2.3.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-psqueues.spec ++++++
--- /var/tmp/diff_new_pack.pv7Ows/_old 2017-07-21 22:48:39.694971744 +0200
+++ /var/tmp/diff_new_pack.pv7Ows/_new 2017-07-21 22:48:39.698971180 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-psqueues
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name psqueues
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.2.2.3
+Version: 0.2.3.0
Release: 0
Summary: Pure priority search queues
License: BSD-3-Clause
++++++ psqueues-0.2.2.3.tar.gz -> psqueues-0.2.3.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/CHANGELOG new/psqueues-0.2.3.0/CHANGELOG
--- old/psqueues-0.2.2.3/CHANGELOG 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/CHANGELOG 2017-07-03 13:10:35.000000000 +0200
@@ -1,3 +1,9 @@
+- 0.2.3.0
+ * Add an `atMostView` function to all PSQ flavours
+ * Bump HUnit dependency to 1.6
+ * Bump QuickCheck dependency to 2.10
+ * Clean up warnings on newer and older GHC versions
+
- 0.2.2.3
* Bump HUnit dependency to 1.5
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/psqueues.cabal new/psqueues-0.2.3.0/psqueues.cabal
--- old/psqueues-0.2.2.3/psqueues.cabal 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/psqueues.cabal 2017-07-03 13:10:35.000000000 +0200
@@ -1,5 +1,5 @@
Name: psqueues
-Version: 0.2.2.3
+Version: 0.2.3.0
License: BSD3
License-file: LICENSE
Maintainer: Jasper Van der Jeugt
@@ -85,17 +85,23 @@
Type: exitcode-stdio-1.0
Hs-source-dirs: src benchmarks
Main-is: Main.hs
+ Ghc-options: -Wall
Other-modules:
BenchmarkTypes
+ Data.BitUtil
Data.FingerTree.PSQueue.Benchmark
+ Data.HashPSQ
Data.HashPSQ.Benchmark
+ Data.HashPSQ.Internal
+ Data.IntPSQ
Data.IntPSQ.Benchmark
+ Data.IntPSQ.Internal
+ Data.OrdPSQ
Data.OrdPSQ.Benchmark
+ Data.OrdPSQ.Internal
Data.PSQueue.Benchmark
- Ghc-options: -Wall
-
Build-depends:
containers >= 0.5
, unordered-containers >= 0.2.4
@@ -119,17 +125,24 @@
Type: exitcode-stdio-1.0
Other-modules:
+ Data.BitUtil
+ Data.HashPSQ
+ Data.HashPSQ.Internal
+ Data.HashPSQ.Tests
+ Data.IntPSQ
+ Data.IntPSQ.Internal
+ Data.IntPSQ.Tests
+ Data.OrdPSQ
+ Data.OrdPSQ.Internal
+ Data.OrdPSQ.Tests
Data.PSQ.Class
Data.PSQ.Class.Gen
Data.PSQ.Class.Tests
Data.PSQ.Class.Util
- Data.HashPSQ.Tests
- Data.IntPSQ.Tests
- Data.OrdPSQ.Tests
Build-depends:
- HUnit >= 1.2 && < 1.6
- , QuickCheck >= 2.7 && < 2.10
+ HUnit >= 1.2 && < 1.7
+ , QuickCheck >= 2.7 && < 2.11
, test-framework >= 0.8 && < 0.9
, test-framework-hunit >= 0.3 && < 0.4
, test-framework-quickcheck2 >= 0.3 && < 0.4
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/src/Data/HashPSQ/Internal.hs new/psqueues-0.2.3.0/src/Data/HashPSQ/Internal.hs
--- old/psqueues-0.2.2.3/src/Data/HashPSQ/Internal.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/src/Data/HashPSQ/Internal.hs 2017-07-03 13:10:35.000000000 +0200
@@ -39,6 +39,7 @@
, insertView
, deleteView
, minView
+ , atMostView
-- * Traversal
, map
@@ -54,12 +55,12 @@
) where
import Control.DeepSeq (NFData (..))
-import Data.Foldable (Foldable (foldr))
+import Data.Foldable (Foldable)
import Data.Hashable
import qualified Data.List as List
import Data.Maybe (isJust)
-import Prelude hiding (foldr, lookup, map, null)
import Data.Traversable
+import Prelude hiding (foldr, lookup, map, null)
import qualified Data.IntPSQ.Internal as IntPSQ
import qualified Data.OrdPSQ as OrdPSQ
@@ -341,6 +342,42 @@
Just (k', p', x', os') ->
(Just (k, p, x), Just (h, p', B k' x' os'))
+-- | Return a list of elements ordered by key whose priorities are at most @pt@,
+-- and the rest of the queue stripped of these elements. The returned list of
+-- elements can be in any order: no guarantees there.
+{-# INLINABLE atMostView #-}
+atMostView
+ :: (Hashable k, Ord k, Ord p)
+ => p -> HashPSQ k p v -> ([(k, p, v)], HashPSQ k p v)
+atMostView pt (HashPSQ t0) =
+ (returns, HashPSQ t2)
+ where
+ -- First we use 'IntPSQ.atMostView' to get a collection of buckets that have
+ -- /AT LEAST/ one element with a low priority. Buckets will usually only
+ -- contain a single element.
+ (buckets, t1) = IntPSQ.atMostView pt t0
+
+ -- We now need to run through the buckets. This will give us a list of
+ -- elements to return and a bunch of buckets to re-insert.
+ (returns, reinserts) = go [] [] buckets
+ where
+ -- We use two accumulators, for returns and re-inserts.
+ go rets reins [] = (rets, reins)
+ go rets reins ((_, p, B k v opsq) : bs) =
+ -- Note that 'elems' should be very small, ideally a null list.
+ let (elems, opsq') = OrdPSQ.atMostView pt opsq
+ rets' = (k, p, v) : elems ++ rets
+ reins' = case toBucket opsq' of
+ Nothing -> reins
+ Just (p', b) -> ((p', b) : reins)
+ in go rets' reins' bs
+
+ -- Now we can do the re-insertion pass.
+ t2 = List.foldl'
+ (\t (p, b@(B k _ _)) -> IntPSQ.unsafeInsertNew (hash k) p b t)
+ t1
+ reinserts
+
--------------------------------------------------------------------------------
-- Traversals
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/src/Data/HashPSQ.hs new/psqueues-0.2.3.0/src/Data/HashPSQ.hs
--- old/psqueues-0.2.2.3/src/Data/HashPSQ.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/src/Data/HashPSQ.hs 2017-07-03 13:10:35.000000000 +0200
@@ -37,6 +37,7 @@
, insertView
, deleteView
, minView
+ , atMostView
-- * Traversal
, map
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/src/Data/IntPSQ/Internal.hs new/psqueues-0.2.3.0/src/Data/IntPSQ/Internal.hs
--- old/psqueues-0.2.2.3/src/Data/IntPSQ/Internal.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/src/Data/IntPSQ/Internal.hs 2017-07-03 13:10:35.000000000 +0200
@@ -40,6 +40,7 @@
, insertView
, deleteView
, minView
+ , atMostView
-- * Traversal
, map
@@ -63,21 +64,17 @@
import Control.Applicative ((<$>), (<*>))
import Control.DeepSeq (NFData (rnf))
-
import Data.Bits
import Data.BitUtil
-import Data.Foldable (Foldable (foldr))
+import Data.Foldable (Foldable)
import Data.List (foldl')
+import qualified Data.List as List
import Data.Maybe (isJust)
+import Data.Traversable
import Data.Word (Word)
-
-import qualified Data.List as List
-
import Prelude hiding (filter, foldl, foldr, lookup, map,
null)
-import Data.Traversable
-
-- TODO (SM): get rid of bang patterns
{-
@@ -197,9 +194,9 @@
-- | /O(1)/ The element with the lowest priority.
findMin :: Ord p => IntPSQ p v -> Maybe (Int, p, v)
findMin t = case t of
- Nil -> Nothing
- Tip k p x -> Just (k, p, x)
- Bin k p x _ _ _ -> Just (k, p, x)
+ Nil -> Nothing
+ Tip k p x -> Just (k, p, x)
+ Bin k p x _ _ _ -> Just (k, p, x)
------------------------------------------------------------------------------
@@ -370,7 +367,7 @@
toList =
go []
where
- go acc Nil = acc
+ go acc Nil = acc
go acc (Tip k' p' x') = (k', p', x') : acc
go acc (Bin k' p' x' _m l r) = (k', p', x') : go (go acc r) l
@@ -431,6 +428,26 @@
Tip k p x -> Just (k, p, x, Nil)
Bin k p x m l r -> Just (k, p, x, merge m l r)
+-- | Return a list of elements ordered by key whose priorities are at most @pt@,
+-- and the rest of the queue stripped of these elements. The returned list of
+-- elements can be in any order: no guarantees there.
+{-# INLINABLE atMostView #-}
+atMostView :: Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
+atMostView pt t0 = go [] t0
+ where
+ go acc t = case t of
+ Nil -> (acc, t)
+ Tip k p x
+ | p > pt -> (acc, t)
+ | otherwise -> ((k, p, x) : acc, Nil)
+
+ Bin k p x m l r
+ | p > pt -> (acc, t)
+ | otherwise ->
+ let (acc', l') = go acc l
+ (acc'', r') = go acc' r
+ in ((k, p, x) : acc'', merge m l' r')
+
------------------------------------------------------------------------------
-- Traversal
@@ -696,6 +713,6 @@
Just xoredKeys ->
fromIntegral mask == highestBitMask (fromIntegral xoredKeys)
- childKey Nil = Nothing
- childKey (Tip k _ _) = Just k
+ childKey Nil = Nothing
+ childKey (Tip k _ _) = Just k
childKey (Bin k _ _ _ _ _) = Just k
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/src/Data/IntPSQ.hs new/psqueues-0.2.3.0/src/Data/IntPSQ.hs
--- old/psqueues-0.2.2.3/src/Data/IntPSQ.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/src/Data/IntPSQ.hs 2017-07-03 13:10:35.000000000 +0200
@@ -40,6 +40,7 @@
, insertView
, deleteView
, minView
+ , atMostView
-- * Traversal
, map
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/src/Data/OrdPSQ/Internal.hs new/psqueues-0.2.3.0/src/Data/OrdPSQ/Internal.hs
--- old/psqueues-0.2.2.3/src/Data/OrdPSQ/Internal.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/src/Data/OrdPSQ/Internal.hs 2017-07-03 13:10:35.000000000 +0200
@@ -2,8 +2,8 @@
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
module Data.OrdPSQ.Internal
( -- * Type
OrdPSQ (..)
@@ -40,6 +40,7 @@
, insertView
, deleteView
, minView
+ , atMostView
-- * Traversals
, map
@@ -67,12 +68,12 @@
, valid
) where
-import Control.DeepSeq (NFData (rnf))
-import Data.Foldable (Foldable (foldr))
-import qualified Data.List as List
-import Data.Maybe (isJust)
-import Prelude hiding (foldr, lookup, map, null)
+import Control.DeepSeq (NFData (rnf))
+import Data.Foldable (Foldable (foldr))
+import qualified Data.List as List
+import Data.Maybe (isJust)
import Data.Traversable
+import Prelude hiding (foldr, lookup, map, null)
--------------------------------------------------------------------------------
-- Types
@@ -350,6 +351,25 @@
secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m'
secondBest (RLoser _ e tl m tr) m' = secondBest tl m `play` Winner e tr m'
+-- | Return a list of elements ordered by key whose priorities are at most @pt@,
+-- and the rest of the queue stripped of these elements. The returned list of
+-- elements can be in any order: no guarantees there.
+atMostView :: (Ord k, Ord p) => p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
+atMostView pt = go []
+ where
+ go acc t@(Winner (E _ p _) _ _)
+ | p > pt = (acc, t)
+ go acc Void = (acc, Void)
+ go acc (Winner (E k p v) Start _) = ((k, p, v) : acc, Void)
+ go acc (Winner e (RLoser _ e' tl m tr) m') =
+ let (acc', t') = go acc (Winner e tl m)
+ (acc'', t'') = go acc' (Winner e' tr m') in
+ (acc'', t' `play` t'')
+ go acc (Winner e (LLoser _ e' tl m tr) m') =
+ let (acc', t') = go acc (Winner e' tl m)
+ (acc'', t'') = go acc' (Winner e tr m') in
+ (acc'', t' `play` t'')
+
--------------------------------------------------------------------------------
-- Traversals
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/src/Data/OrdPSQ.hs new/psqueues-0.2.3.0/src/Data/OrdPSQ.hs
--- old/psqueues-0.2.2.3/src/Data/OrdPSQ.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/src/Data/OrdPSQ.hs 2017-07-03 13:10:35.000000000 +0200
@@ -11,9 +11,8 @@
-- This means it is similar to the
-- <http://hackage.haskell.org/package/PSQueue-1.1 PSQueue> package but
-- our benchmarks showed it perform quite a bit faster.
+{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE BangPatterns #-}
module Data.OrdPSQ
( -- * Type
OrdPSQ
@@ -48,6 +47,7 @@
, insertView
, deleteView
, minView
+ , atMostView
-- * Traversals
, map
@@ -57,6 +57,6 @@
, valid
) where
-import Prelude hiding (map, lookup, null, foldr)
+import Prelude hiding (foldr, lookup, map, null)
import Data.OrdPSQ.Internal
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/tests/Data/PSQ/Class/Tests.hs new/psqueues-0.2.3.0/tests/Data/PSQ/Class/Tests.hs
--- old/psqueues-0.2.2.3/tests/Data/PSQ/Class/Tests.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/tests/Data/PSQ/Class/Tests.hs 2017-07-03 13:10:35.000000000 +0200
@@ -73,6 +73,7 @@
, testProperty "fold'" (untag' prop_fold')
, testProperty "foldr" (untag' prop_foldr)
, testProperty "valid" (untag' prop_valid)
+ , testProperty "atMostView" (untag' prop_atMostView)
]
where
untag' :: Tagged psq test -> test
@@ -439,3 +440,19 @@
Show (psq Int Char))
=> Tagged psq (psq Int Char -> Bool)
prop_valid = Tagged valid
+
+prop_atMostView
+ :: forall psq. (PSQ psq, Show (Key psq), Show (psq Int Char))
+ => Tagged psq (psq Int Char -> Property)
+prop_atMostView = Tagged $ \t ->
+ forAll arbitraryPriority $ \p ->
+ let (elems, t') = atMostView p t in
+ -- 1. Test that priorities are at most 'p'.
+ and [p' <= p | (_, p', _) <- elems] &&
+ -- 2. Test that the remaining priorities are larger than 'p'.
+ (case findMin t' of
+ Nothing -> True
+ Just (_, p', _) -> p' > p) &&
+ -- 2. Test that the size of the removed elements and the new queue total
+ -- the original size.
+ length elems + size t' == size t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/tests/Data/PSQ/Class/Util.hs new/psqueues-0.2.3.0/tests/Data/PSQ/Class/Util.hs
--- old/psqueues-0.2.2.3/tests/Data/PSQ/Class/Util.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/tests/Data/PSQ/Class/Util.hs 2017-07-03 13:10:35.000000000 +0200
@@ -68,7 +68,7 @@
assertErrorCall handler x = handle
(\e -> case fromException e of
Just (ErrorCall str) -> handler str
- Nothing -> assertFailure $
+ _ -> assertFailure $
"assertErrorCall: expected `error` but got: " ++ show e)
(x `seq` assertFailure
"assertErrorCall: evaluated to WHNF and no exception was thrown")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/psqueues-0.2.2.3/tests/Data/PSQ/Class.hs new/psqueues-0.2.3.0/tests/Data/PSQ/Class.hs
--- old/psqueues-0.2.2.3/tests/Data/PSQ/Class.hs 2016-11-28 11:35:46.000000000 +0100
+++ new/psqueues-0.2.3.0/tests/Data/PSQ/Class.hs 2017-07-03 13:10:35.000000000 +0200
@@ -68,6 +68,8 @@
:: Ord p => Key psq -> psq p v -> Maybe (p, v, psq p v)
minView
:: Ord p => psq p v -> Maybe (Key psq, p, v, psq p v)
+ atMostView
+ :: Ord p => p -> psq p v -> ([(Key psq, p, v)], psq p v)
-- Traversals
map :: Ord p => (Key psq -> p -> v -> w) -> psq p v -> psq p w
@@ -99,6 +101,7 @@
insertView = IntPSQ.insertView
deleteView = IntPSQ.deleteView
minView = IntPSQ.minView
+ atMostView = IntPSQ.atMostView
map = IntPSQ.map
fold' = IntPSQ.fold'
valid = IntPSQ.valid
@@ -124,6 +127,7 @@
insertView = OrdPSQ.insertView
deleteView = OrdPSQ.deleteView
minView = OrdPSQ.minView
+ atMostView = OrdPSQ.atMostView
map = OrdPSQ.map
fold' = OrdPSQ.fold'
valid = OrdPSQ.valid
@@ -149,6 +153,7 @@
insertView = HashPSQ.insertView
deleteView = HashPSQ.deleteView
minView = HashPSQ.minView
+ atMostView = HashPSQ.atMostView
map = HashPSQ.map
fold' = HashPSQ.fold'
valid = HashPSQ.valid
