pool 0.1.0 → 0.1.0.1

raw patch · 2 files changed

+16/−22 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Pool.hs +15/−21
• pool.cabal +1/−1

@@ -14,7 +14,7 @@     ) where  import Data.IORef (IORef, newIORef, atomicModifyIORef, readIORef)-import Control.Exception (throwIO, Exception)+import Control.Exception (throwIO, Exception, bracket, finally) import qualified Control.Exception as E import Data.Typeable import qualified Control.Monad.IO.Control as I@@ -46,28 +46,31 @@     d <- readIORef $ poolData p     return $ PoolStats (poolMax p) (length $ poolAvail d) (poolCreated d) -createPool :: (MonadIO m, I.MonadControlIO m)+createPool :: I.MonadControlIO m            => IO a -> (a -> IO ()) -> Int -> (Pool a -> m b) -> m b createPool mk fr mx f = createPoolCheckAlive mk fr mx f $ const $ return True  createPoolCheckAlive-    :: (MonadIO m, I.MonadControlIO m)+    :: I.MonadControlIO m     => IO a -> (a -> IO ()) -> Int -> (Pool a -> m b)     -> (a -> IO Bool) -- ^ is the resource alive?     -> m b createPoolCheckAlive mk fr mx f ca = do     pd <- liftIO $ newIORef $ PoolData [] 0-    I.finally (f $ Pool mx pd mk fr ca) $ liftIO $ do+    finallyIO (f $ Pool mx pd mk fr ca) $ do         PoolData ress _ <- readIORef pd         mapM_ fr ress +finallyIO :: I.MonadControlIO m => m a -> IO b -> m a+finallyIO a io = I.controlIO $ \runInIO -> finally (runInIO a) io+                            data PoolExhaustedException = PoolExhaustedException     deriving (Show, Typeable) instance Exception PoolExhaustedException  -- | This function throws a 'PoolExhaustedException' when no resources are -- available. See 'withPoolAllocate' to avoid this.-withPool' :: (MonadIO m, I.MonadControlIO m) => Pool a -> (a -> m b) -> m b+withPool' :: I.MonadControlIO m => Pool a -> (a -> m b) -> m b withPool' p f = do     x <- withPool p f     case x of@@ -82,14 +85,9 @@     x <- withPool p f     case x of         Just x' -> return x'-        Nothing ->-            I.bracket-                (liftIO $ poolMake p)-                (liftIO . poolFree p)-                f+        Nothing -> I.liftIOOp (bracket (poolMake p) (poolFree p)) f -withPool :: (MonadIO m, I.MonadControlIO m)-         => Pool a -> (a -> m b) -> m (Maybe b)+withPool :: I.MonadControlIO m => Pool a -> (a -> m b) -> m (Maybe b) withPool p f = I.mask $ \unmask -> do     eres <- liftIO $ atomicModifyIORef (poolData p) $ \pd ->         case poolAvail pd of@@ -99,24 +97,20 @@         Left pc ->             if pc >= poolMax p                 then return Nothing-                else I.bracket-                    (liftIO $ poolMake p)-                    (insertResource 1)-                    (liftM Just . unmask . f)+                else I.liftIOOp (bracket (poolMake p) (insertResource 1))+                                (liftM Just . unmask . f)         Right res -> do             isAlive <- I.try $ unmask $ liftIO $ poolCheckAlive p res             case isAlive :: Either E.SomeException Bool of-                Right True ->-                    I.finally-                        (liftM Just $ unmask $ f res)-                        (insertResource 0 res)+                Right True -> finallyIO (liftM Just $ unmask $ f res)+                                        (insertResource 0 res)                 _ -> do                     -- decrement the poolCreated count and then start over                     liftIO $ atomicModifyIORef (poolData p) $ \pd ->                         (pd { poolCreated = poolCreated pd - 1}, ())                     unmask $ withPool p f   where-    insertResource i x = liftIO $ atomicModifyIORef (poolData p) $ \pd ->+    insertResource i x = atomicModifyIORef (poolData p) $ \pd ->         (pd { poolAvail = x : poolAvail pd                 , poolCreated = i + poolCreated pd                 }, ())

@@ -1,5 +1,5 @@ name:            pool-version:         0.1.0+version:         0.1.0.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>