Bryan O'Sullivan avatar Bryan O'Sullivan committed 2f0803f

Tiny cleanups.

Comments (0)

Files changed (1)

-{-# LANGUAGE NamedFieldPuns, RecordWildCards, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ScopedTypeVariables #-}
 
 -- |
 -- Module:      Data.Pool
 import Control.Concurrent.STM
 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 Control.Monad.CatchIO (MonadCatchIO, onException)
 import Data.Hashable (hash)
 import Data.List (partition)
 import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
     -- 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.
         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
 -- 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 :: MonadCatchIO io => 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 <- liftIO $ ((`mod` numStripes) . hash) <$> myThreadId
   let LocalPool{..} = localPools V.! i
         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` (liftIO $ do
            destroy resource `catch` \(_::SomeException) -> return ()
            atomically (modifyTVar_ inUse (subtract 1)))
   liftIO $ do
-      now <- getCurrentTime
-      atomically $ modifyTVar_ entries (Entry resource now:)
+    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
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.