resource-pool-catchio 0.2.0.3 → 0.2.1.0

raw patch · 2 files changed

+49/−10 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Pool.hs +48/−9
• resource-pool-catchio.cabal +1/−1

@@ -1,5 +1,9 @@ {-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ScopedTypeVariables #-} +#if !MIN_VERSION_base(4,3,0)+{-# LANGUAGE Rank2Types #-}+#endif+ -- | -- Module:      Data.Pool -- Copyright:   (c) 2011 MailRank, Inc.@@ -21,8 +25,12 @@ module Data.Pool     (       Pool(idleTime, maxResources, numStripes)+    , LocalPool     , createPool     , withResource+    , takeResource+    , destroyResource+    , putResource     ) where  import Control.Applicative ((<$>))@@ -142,7 +150,7 @@         writeTVar entries fresh         modifyTVar_ inUse (subtract (length stale))       return (map entry stale)-    forM_ resources $ \resource -> do+    forM_ resources $ \resource ->       destroy resource `catch` \(_::SomeException) -> return ()  -- | Temporarily take a resource from a 'Pool', perform an action with@@ -166,9 +174,27 @@ -- an exception. withResource :: MonadCatchIO m => Pool a -> (a -> m b) -> m b {-# SPECIALIZE withResource :: Pool a -> (a -> IO b) -> IO b #-}-withResource Pool{..} act = do+withResource pool act = block $ do+  (resource, local) <- liftIO $ takeResource pool+  ret <- unblock (act resource) `onException`+            liftIO (destroyResource pool local resource)+  liftIO $ putResource local resource+  return ret+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE withResource #-}+#endif++-- | Take a resource from the pool, following the same results as+-- 'withResource'. Note that this function should be used with caution, as+-- improper exception handling can lead to leaked resources.+--+-- This function returns both a resource and the @LocalPool@ it came from so+-- that it may either be destroyed (via 'destroyResource') or returned to the+-- pool (via 'putResource').+takeResource :: Pool a -> IO (a, LocalPool a)+takeResource Pool{..} = do   i <- liftIO $ ((`mod` numStripes) . hash) <$> myThreadId-  let LocalPool{..} = localPools V.! i+  let pool@LocalPool{..} = localPools V.! i   resource <- liftIO . join . atomically $ do     ents <- readTVar entries     case ents of@@ -179,15 +205,28 @@         writeTVar inUse $! used + 1         return $           create `onException` atomically (modifyTVar_ inUse (subtract 1))-  ret <- (act resource) `onException` (do-           liftIO $ destroy resource `catch` \(_::SomeException) -> return ()-           liftIO $ atomically (modifyTVar_ inUse (subtract 1)))-  liftIO $ do+  return (resource, pool)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE takeResource #-}+#endif++-- | Destroy a resource. Note that this will ignore any exceptions in the+-- destroy function.+destroyResource :: Pool a -> LocalPool a -> a -> IO ()+destroyResource Pool{..} LocalPool{..} resource = do+   destroy resource `catch` \(_::SomeException) -> return ()+   atomically (modifyTVar_ inUse (subtract 1))+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE destroyResource #-}+#endif++-- | Return a resource to the given 'LocalPool'.+putResource :: LocalPool a -> a -> IO ()+putResource LocalPool{..} resource = do     now <- getCurrentTime     atomically $ modifyTVar_ entries (Entry resource now:)-  return ret #if __GLASGOW_HASKELL__ >= 700-{-# INLINABLE withResource #-}+{-# INLINABLE putResource #-} #endif  modifyTVar_ :: TVar a -> (a -> a) -> STM ()

@@ -1,5 +1,5 @@ name:                resource-pool-catchio-version:             0.2.0.3+version:             0.2.1.0 synopsis:            Fork of resource-pool, with a MonadCatchIO constraint description:   This is a fork of Bryan O'Sullivan's resource-pool package. The only