Compatibility with resource-pool < 0.3

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

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

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
 --