Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-resource-pool for openSUSE:Factory checked in at 2023-01-18 13:10:24 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-resource-pool (Old) and /work/SRC/openSUSE:Factory/.ghc-resource-pool.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-resource-pool" Wed Jan 18 13:10:24 2023 rev:12 rq:1059100 version:0.4.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-resource-pool/ghc-resource-pool.changes 2022-08-01 21:30:44.721716094 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-resource-pool.new.32243/ghc-resource-pool.changes 2023-01-18 13:10:47.944816797 +0100 @@ -1,0 +2,11 @@ +Mon Jan 16 13:43:16 UTC 2023 - Peter Simons <[email protected]> + +- Update resource-pool to version 0.4.0.0. + # resource-pool-0.4.0.0 (2023-01-16) + * Require `poolMaxResources` to be not smaller than the number of stripes. + * Add support for setting the number of stripes. + * Hide the constructor of `PoolConfig` from the public API and provide + `defaultPoolConfig` so that future additions to `PoolConfig` don't require + major version bumps. + +------------------------------------------------------------------- Old: ---- resource-pool-0.3.1.0.tar.gz New: ---- resource-pool-0.4.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-resource-pool.spec ++++++ --- /var/tmp/diff_new_pack.pMN9rT/_old 2023-01-18 13:10:48.544820354 +0100 +++ /var/tmp/diff_new_pack.pMN9rT/_new 2023-01-18 13:10:48.548820377 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-resource-pool # -# Copyright (c) 2022 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,13 +18,14 @@ %global pkg_name resource-pool Name: ghc-%{pkg_name} -Version: 0.3.1.0 +Version: 0.4.0.0 Release: 0 Summary: A high-performance striped resource pooling implementation License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-hashable-devel BuildRequires: ghc-primitive-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-time-devel ++++++ resource-pool-0.3.1.0.tar.gz -> resource-pool-0.4.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/resource-pool-0.3.1.0/CHANGELOG.md new/resource-pool-0.4.0.0/CHANGELOG.md --- old/resource-pool-0.3.1.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/resource-pool-0.4.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,10 @@ +# resource-pool-0.4.0.0 (2023-01-16) +* Require `poolMaxResources` to be not smaller than the number of stripes. +* Add support for setting the number of stripes. +* Hide the constructor of `PoolConfig` from the public API and provide + `defaultPoolConfig` so that future additions to `PoolConfig` don't require + major version bumps. + # resource-pool-0.3.1.0 (2022-06-15) * Add `tryWithResource` and `tryTakeResource`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/resource-pool-0.3.1.0/resource-pool.cabal new/resource-pool-0.4.0.0/resource-pool.cabal --- old/resource-pool-0.3.1.0/resource-pool.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/resource-pool-0.4.0.0/resource-pool.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,7 @@ cabal-version: 2.4 build-type: Simple name: resource-pool -version: 0.3.1.0 +version: 0.4.0.0 license: BSD-3-Clause license-file: LICENSE category: Data, Database, Network @@ -14,7 +14,8 @@ flexibly-sized collections of resources such as database connections. -tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 +tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.5 + || ==9.4.3 extra-doc-files: CHANGELOG.md @@ -33,6 +34,7 @@ Data.Pool.Introspection build-depends: base >= 4.11 && < 5 + , hashable >= 1.1.0.0 , primitive >= 0.7 , time diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/resource-pool-0.3.1.0/src/Data/Pool/Internal.hs new/resource-pool-0.4.0.0/src/Data/Pool/Internal.hs --- old/resource-pool-0.3.1.0/src/Data/Pool/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/resource-pool-0.4.0.0/src/Data/Pool/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -8,23 +8,20 @@ import Control.Concurrent import Control.Exception import Control.Monad +import Data.Hashable (hash) import Data.IORef import Data.Primitive.SmallArray import GHC.Clock import qualified Data.List as L -- | Striped resource pool based on "Control.Concurrent.QSem". --- --- The number of stripes is arranged to be equal to the number of capabilities --- so that they never compete over access to the same stripe. This results in a --- very good performance in a multi-threaded environment. data Pool a = Pool { poolConfig :: !(PoolConfig a) , localPools :: !(SmallArray (LocalPool a)) , reaperRef :: !(IORef ()) } --- | A single, capability-local pool. +-- | A single, local pool. data LocalPool a = LocalPool { stripeId :: !Int , stripeVar :: !(MVar (Stripe a)) @@ -53,29 +50,59 @@ -- | Configuration of a 'Pool'. data PoolConfig a = PoolConfig - { createResource :: !(IO a) - -- ^ The action that creates a new resource. - , freeResource :: !(a -> IO ()) - -- ^ The action that destroys an existing resource. - , poolCacheTTL :: !Double + { createResource :: !(IO a) + , freeResource :: !(a -> IO ()) + , poolCacheTTL :: !Double + , poolMaxResources :: !Int + , poolNumStripes :: !(Maybe Int) + } + +-- | Create a 'PoolConfig' with optional parameters having default values. +-- +-- For setting optional parameters have a look at: +-- +-- - 'setNumStripes' +-- +-- @since 0.4.0.0 +defaultPoolConfig + :: IO a + -- ^ The action that creates a new resource. + -> (a -> IO ()) + -- ^ The action that destroys an existing resource. + -> Double -- ^ The amount of seconds for which an unused resource is kept around. The -- smallest acceptable value is @0.5@. -- -- /Note:/ the elapsed time before destroying a resource may be a little -- longer than requested, as the collector thread wakes at 1-second intervals. - , poolMaxResources :: !Int - -- ^ The maximum number of resources to keep open across all stripes. The + -> Int + -- ^ The maximum number of resources to keep open __across all stripes__. The -- smallest acceptable value is @1@. -- -- /Note:/ for each stripe the number of resources is divided by the number of - -- capabilities and rounded up. Therefore the pool might end up creating up to - -- @N - 1@ resources more in total than specified, where @N@ is the number of - -- capabilities. + -- stripes and rounded up, hence the pool might end up creating up to @N - 1@ + -- resources more in total than specified, where @N@ is the number of stripes. + -> PoolConfig a +defaultPoolConfig create free cacheTTL maxResources = PoolConfig + { createResource = create + , freeResource = free + , poolCacheTTL = cacheTTL + , poolMaxResources = maxResources + , poolNumStripes = Nothing } --- | Create a new striped resource pool. +-- | Set the number of stripes in the pool. -- --- The number of stripes is equal to the number of capabilities. +-- If set to 'Nothing' (the default value), the pool will create the amount of +-- stripes equal to the number of capabilities. This ensures that threads never +-- compete over access to the same stripe and results in a very good performance +-- in a multi-threaded environment. +-- +-- @since 0.4.0.0 +setNumStripes :: Maybe Int -> PoolConfig a -> PoolConfig a +setNumStripes numStripes pc = pc { poolNumStripes = numStripes } + +-- | Create a new striped resource pool. -- -- /Note:/ although the runtime system will destroy all idle resources when the -- pool is garbage collected, it's recommended to manually call @@ -87,9 +114,11 @@ error "poolCacheTTL must be at least 0.5" when (poolMaxResources pc < 1) $ do error "poolMaxResources must be at least 1" - numStripes <- getNumCapabilities + numStripes <- maybe getNumCapabilities pure (poolNumStripes pc) when (numStripes < 1) $ do error "numStripes must be at least 1" + when (poolMaxResources pc < numStripes) $ do + error "poolMaxResources must not be smaller than numStripes" pools <- fmap (smallArrayFromListN numStripes) . forM [1..numStripes] $ \n -> do ref <- newIORef () stripe <- newMVar Stripe @@ -168,11 +197,27 @@ ---------------------------------------- -- Helpers --- | Get a capability-local pool. +-- | Get a local pool. getLocalPool :: SmallArray (LocalPool a) -> IO (LocalPool a) getLocalPool pools = do - (cid, _) <- threadCapability =<< myThreadId - pure $ pools `indexSmallArray` (cid `rem` sizeofSmallArray pools) + sid <- if stripes == 1 + -- If there is just one stripe, there is no choice. + then pure 0 + else do + capabilities <- getNumCapabilities + -- If the number of stripes is smaller than the number of capabilities and + -- doesn't divide it, selecting a stripe by a capability the current + -- thread runs on wouldn't give equal load distribution across all stripes + -- (e.g. if there are 2 stripes and 3 capabilities, stripe 0 would be used + -- by capability 0 and 2, while stripe 1 would only be used by capability + -- 1, a 100% load difference). In such case we select based on the id of a + -- thread. + if stripes < capabilities && capabilities `rem` stripes /= 0 + then hash <$> myThreadId + else fmap fst . threadCapability =<< myThreadId + pure $ pools `indexSmallArray` (sid `rem` stripes) + where + stripes = sizeofSmallArray pools -- | Wait for the resource to be put into a given 'MVar'. waitForResource :: MVar (Stripe a) -> MVar (Maybe a) -> IO (Maybe a) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/resource-pool-0.3.1.0/src/Data/Pool/Introspection.hs new/resource-pool-0.4.0.0/src/Data/Pool/Introspection.hs --- old/resource-pool-0.3.1.0/src/Data/Pool/Introspection.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/resource-pool-0.4.0.0/src/Data/Pool/Introspection.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,11 +1,15 @@ -- | A variant of "Data.Pool" with introspection capabilities. module Data.Pool.Introspection ( -- * Pool - PoolConfig(..) - , Pool + Pool , LocalPool , newPool + -- ** Configuration + , PoolConfig + , defaultPoolConfig + , setNumStripes + -- * Resource management , Resource(..) , Acquisition(..) @@ -89,7 +93,7 @@ else takeAvailableResource pool t1 lp stripe -- | A variant of 'withResource' that doesn't execute the action and returns --- 'Nothing' instead of blocking if the capability-local pool is exhausted. +-- 'Nothing' instead of blocking if the local pool is exhausted. tryWithResource :: Pool a -> (Resource a -> IO r) -> IO (Maybe r) tryWithResource pool act = mask $ \unmask -> tryTakeResource pool >>= \case Just (res, localPool) -> do @@ -99,7 +103,7 @@ Nothing -> pure Nothing -- | A variant of 'takeResource' that returns 'Nothing' instead of blocking if --- the capability-local pool is exhausted. +-- the local pool is exhausted. tryTakeResource :: Pool a -> IO (Maybe (Resource a, LocalPool a)) tryTakeResource pool = mask_ $ do t1 <- getMonotonicTime diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/resource-pool-0.3.1.0/src/Data/Pool.hs new/resource-pool-0.4.0.0/src/Data/Pool.hs --- old/resource-pool-0.3.1.0/src/Data/Pool.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/resource-pool-0.4.0.0/src/Data/Pool.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,11 +2,15 @@ -- collections of resources such as database connections. module Data.Pool ( -- * Pool - PoolConfig(..) - , Pool + Pool , LocalPool , newPool + -- ** Configuration + , PoolConfig + , defaultPoolConfig + , setNumStripes + -- * Resource management , withResource , takeResource @@ -72,7 +76,7 @@ else takeAvailableResource pool lp stripe -- | A variant of 'withResource' that doesn't execute the action and returns --- 'Nothing' instead of blocking if the capability-local pool is exhausted. +-- 'Nothing' instead of blocking if the local pool is exhausted. tryWithResource :: Pool a -> (a -> IO r) -> IO (Maybe r) tryWithResource pool act = mask $ \unmask -> tryTakeResource pool >>= \case Just (res, localPool) -> do @@ -82,7 +86,7 @@ Nothing -> pure Nothing -- | A variant of 'takeResource' that returns 'Nothing' instead of blocking if --- the capability-local pool is exhausted. +-- the local pool is exhausted. tryTakeResource :: Pool a -> IO (Maybe (a, LocalPool a)) tryTakeResource pool = mask_ $ do lp <- getLocalPool (localPools pool) @@ -103,6 +107,7 @@ , freeResource = free , poolCacheTTL = realToFrac idleTime , poolMaxResources = numStripes * maxResources + , poolNumStripes = Just numStripes } ----------------------------------------
