diff --git a/faktory.cabal b/faktory.cabal index 9c94979..1f6ff6b 100644 --- a/faktory.cabal +++ b/faktory.cabal @@ -4,7 +4,7 @@ cabal-version: 1.18 -- -- see: https://github.com/sol/hpack -- --- hash: 690e0deaa46069fadbd59ee63f2da1a97d4fb5bcadabf75910d088636b34bbf9 +-- hash: 89f1872b73104a5e3c9199c20692c3b0da3ba450a23bdfd7aad3d2bacc7bcb6c name: faktory version: 1.1.3.0 @@ -56,6 +56,7 @@ source-repository head library exposed-modules: + Data.Pool.Compat Faktory.Client Faktory.Connection Faktory.Ent.Batch diff --git a/library/Data/Pool/Compat.hs b/library/Data/Pool/Compat.hs new file mode 100644 index 0000000..74c69b4 --- /dev/null +++ b/library/Data/Pool/Compat.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE CPP #-} + +module Data.Pool.Compat + ( module Data.Pool + , createPool + ) where + +import Prelude + +import Data.Pool hiding (createPool) +#if MIN_VERSION_resource_pool(0,3,0) +#else +import Control.Concurrent (getNumCapabilities) +import qualified Data.Pool as Pool +#endif + +createPool + :: IO a + -> (a -> IO ()) + -> Double + -> Int + -> IO (Pool a) +createPool create destroy timeout size = do +#if MIN_VERSION_resource_pool(0,3,0) + newPool $ defaultPoolConfig create destroy timeout size +#else + -- Re-implement instead of using the deprecated compatibility function, so + -- that we can get a consistent numStripes and size behavior. + numStripes <- getNumCapabilities + Pool.createPool create destroy numStripes (realToFrac timeout) size +#endif diff --git a/library/Faktory/Pool.hs b/library/Faktory/Pool.hs index a88f82e..54dbfa4 100644 --- a/library/Faktory/Pool.hs +++ b/library/Faktory/Pool.hs @@ -24,8 +24,8 @@ import Faktory.Prelude import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Reader (MonadReader, asks) import Data.Aeson (ToJSON) -import Data.Pool (Pool) -import qualified Data.Pool as Pool +import Data.Pool.Compat (Pool) +import qualified Data.Pool.Compat as Pool import Faktory.Job hiding (buildJob, perform) import qualified Faktory.Job as Job import Faktory.Producer @@ -59,14 +59,13 @@ newFaktoryPool -> PoolSettings -> m FaktoryPool newFaktoryPool settings PoolSettings {..} = do - liftIO - . fmap FaktoryPool - . Pool.newPool - $ Pool.defaultPoolConfig - (newProducer settings) - closeProducer - (fromIntegral settingsTimeout) - (fromIntegral settingsSize) + liftIO $ + FaktoryPool + <$> Pool.createPool + (newProducer settings) + closeProducer + (fromIntegral settingsTimeout) + (fromIntegral settingsSize) -- | 'Faktory.Job.perform' but using a 'Producer' from the pool --