resource-pool 0.1.0.2 → 0.1.1.0

raw patch · 2 files changed

+21/−13 lines, 2 filesdep +MonadCatchIO-transformersdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MonadCatchIO-transformers, transformers

API changes (from Hackage documentation)

Files

• Data/Pool.hs +18/−12
• resource-pool.cabal +3/−1

@@ -1,4 +1,4 @@-{-# LANGUAGE NamedFieldPuns, RecordWildCards, ScopedTypeVariables #-}+{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ScopedTypeVariables #-}  -- | -- Module:      Data.Pool@@ -28,8 +28,10 @@ import Control.Applicative ((<$>)) import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay) import Control.Concurrent.STM-import Control.Exception (SomeException, catch, onException)+import Control.Exception (SomeException, catch) import Control.Monad (forM_, forever, join, liftM2, unless, when)+import Control.Monad.CatchIO (MonadCatchIO, onException)+import Control.Monad.IO.Class (liftIO) import Data.Hashable (hash) import Data.List (partition) import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)@@ -65,7 +67,7 @@     -- The smallest acceptable value is 0.5 seconds.     --     -- The elapsed time before closing may be a little longer than-    -- requested, as the reaper thread wakes at 2-second intervals.+    -- requested, as the reaper thread wakes at 1-second intervals.     , maxResources :: Int     -- ^ Maximum number of resources to maintain per stripe.  The     -- smallest acceptable value is 1.@@ -141,7 +143,6 @@         modifyTVar_ inUse (subtract (length stale))       return (map entry stale)     forM_ resources $ \resource -> do-      -- debug "reaper" "destroying idle resource"       destroy resource `catch` \(_::SomeException) -> return ()                -- | Temporarily take a resource from a 'Pool', perform an action with@@ -163,11 +164,12 @@ -- destroy a pooled resource, as doing so will almost certainly cause -- a subsequent user (who expects the resource to be valid) to throw -- an exception.-withResource :: Pool a -> (a -> IO b) -> IO b+withResource :: MonadCatchIO m => Pool a -> (a -> m b) -> m b+{-# SPECIALIZE withResource :: Pool a -> (a -> IO b) -> IO b #-} withResource Pool{..} act = do-  i <- ((`mod` numStripes) . hash) <$> myThreadId+  i <- liftIO $ ((`mod` numStripes) . hash) <$> myThreadId   let LocalPool{..} = localPools V.! i-  resource <- join . atomically $ do+  resource <- liftIO . join . atomically $ do     ents <- readTVar entries     case ents of       (Entry{..}:es) -> writeTVar entries es >> return create@@ -175,14 +177,18 @@         used <- readTVar inUse         when (used == maxResources) retry         writeTVar inUse $! used + 1-        return $ do+        return $           create `onException` atomically (modifyTVar_ inUse (subtract 1))-  ret <- act resource `onException` do+  ret <- act resource `onException` (liftIO $ do            destroy resource `catch` \(_::SomeException) -> return ()-           atomically (modifyTVar_ inUse (subtract 1))-  now <- getCurrentTime-  atomically $ modifyTVar_ entries (Entry resource now:)+           atomically (modifyTVar_ inUse (subtract 1)))+  liftIO $ do+    now <- getCurrentTime+    atomically $ modifyTVar_ entries (Entry resource now:)   return ret+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE withResource #-}+#endif  modifyTVar_ :: TVar a -> (a -> a) -> STM () modifyTVar_ v f = readTVar v >>= \a -> writeTVar v $! f a

@@ -1,5 +1,5 @@ name:                resource-pool-version:             0.1.0.2+version:             0.1.1.0 synopsis:            A high-performance striped resource pooling implementation description:   A high-performance striped pooling abstraction for managing@@ -30,6 +30,8 @@   build-depends:            base == 4.*,     hashable,+    MonadCatchIO-transformers,+    transformers,     stm,     time,     vector >= 0.7