module UnliftIO.Pool
  ( Pool
  , P.PoolConfig
  , P.setNumStripes
  , LocalPool
  , mkDefaultPoolConfig
  , newPool
  , withResource
  , takeResource
  , tryWithResource
  , tryTakeResource
  , destroyResource
  , putResource
  , destroyAllResources
  ) where

import           Control.Monad.IO.Unlift (MonadUnliftIO(..), liftIO, unliftIO)
import qualified Data.Pool as P
import           Data.Pool (PoolConfig)

type Pool = P.Pool

type LocalPool = P.LocalPool

mkDefaultPoolConfig :: MonadUnliftIO m => m a -> (a -> m ()) -> Double -> Int -> m (PoolConfig a)
mkDefaultPoolConfig :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (a -> m ()) -> Double -> Int -> m (PoolConfig a)
mkDefaultPoolConfig m a
create a -> m ()
destroy Double
keepAlive Int
maxOpen =
  ((forall a. m a -> IO a) -> IO (PoolConfig a)) -> m (PoolConfig a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (PoolConfig a))
 -> m (PoolConfig a))
-> ((forall a. m a -> IO a) -> IO (PoolConfig a))
-> m (PoolConfig a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
io ->
    PoolConfig a -> IO (PoolConfig a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolConfig a -> IO (PoolConfig a))
-> PoolConfig a -> IO (PoolConfig a)
forall a b. (a -> b) -> a -> b
$ IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
P.defaultPoolConfig (m a -> IO a
forall a. m a -> IO a
io m a
create) (m () -> IO ()
forall a. m a -> IO a
io (m () -> IO ()) -> (a -> m ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
destroy) Double
keepAlive Int
maxOpen

-- | Lifted version of 'P.newPool'
--
-- @since 0.4.2.0
newPool :: MonadUnliftIO m => PoolConfig a -> m (Pool a)
newPool :: forall (m :: * -> *) a.
MonadUnliftIO m =>
PoolConfig a -> m (Pool a)
newPool PoolConfig a
config =
  ((forall a. m a -> IO a) -> IO (Pool a)) -> m (Pool a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Pool a)) -> m (Pool a))
-> ((forall a. m a -> IO a) -> IO (Pool a)) -> m (Pool a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
io ->
    IO (Pool a) -> IO (Pool a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pool a) -> IO (Pool a)) -> IO (Pool a) -> IO (Pool a)
forall a b. (a -> b) -> a -> b
$ PoolConfig a -> IO (Pool a)
forall a. PoolConfig a -> IO (Pool a)
P.newPool PoolConfig a
config

withResource :: MonadUnliftIO m => Pool a -> (a -> m b) -> m b
withResource :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
Pool a -> (a -> m b) -> m b
withResource Pool a
pool a -> m b
action =
  ((forall a. m a -> IO a) -> IO b) -> m b
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
io ->
    IO b -> IO b
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ Pool a -> (a -> IO b) -> IO b
forall a r. Pool a -> (a -> IO r) -> IO r
P.withResource Pool a
pool ((a -> IO b) -> IO b) -> (a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \a
a ->
      m b -> IO b
forall a. m a -> IO a
io (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> m b
action a
a

takeResource :: MonadUnliftIO m => Pool a -> m (a, LocalPool a)
takeResource :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Pool a -> m (a, LocalPool a)
takeResource Pool a
pool = IO (a, LocalPool a) -> m (a, LocalPool a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, LocalPool a) -> m (a, LocalPool a))
-> IO (a, LocalPool a) -> m (a, LocalPool a)
forall a b. (a -> b) -> a -> b
$ Pool a -> IO (a, LocalPool a)
forall a. Pool a -> IO (a, LocalPool a)
P.takeResource Pool a
pool

tryWithResource :: MonadUnliftIO m => Pool a -> (a -> m b) -> m (Maybe b)
tryWithResource :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
Pool a -> (a -> m b) -> m (Maybe b)
tryWithResource Pool a
pool a -> m b
action =
  ((forall a. m a -> IO a) -> IO (Maybe b)) -> m (Maybe b)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Maybe b)) -> m (Maybe b))
-> ((forall a. m a -> IO a) -> IO (Maybe b)) -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
io ->
    IO (Maybe b) -> IO (Maybe b)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe b) -> IO (Maybe b)) -> IO (Maybe b) -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ Pool a -> (a -> IO b) -> IO (Maybe b)
forall a r. Pool a -> (a -> IO r) -> IO (Maybe r)
P.tryWithResource Pool a
pool ((a -> IO b) -> IO (Maybe b)) -> (a -> IO b) -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ \a
a ->
      m b -> IO b
forall a. m a -> IO a
io (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> m b
action a
a

tryTakeResource :: MonadUnliftIO m => Pool a -> m (Maybe (a, LocalPool a))
tryTakeResource :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Pool a -> m (Maybe (a, LocalPool a))
tryTakeResource Pool a
pool = IO (Maybe (a, LocalPool a)) -> m (Maybe (a, LocalPool a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (a, LocalPool a)) -> m (Maybe (a, LocalPool a)))
-> IO (Maybe (a, LocalPool a)) -> m (Maybe (a, LocalPool a))
forall a b. (a -> b) -> a -> b
$ Pool a -> IO (Maybe (a, LocalPool a))
forall a. Pool a -> IO (Maybe (a, LocalPool a))
P.tryTakeResource Pool a
pool

destroyResource :: MonadUnliftIO m => Pool a -> LocalPool a -> a -> m ()
destroyResource :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Pool a -> LocalPool a -> a -> m ()
destroyResource Pool a
pool LocalPool a
localPool a
a = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Pool a -> LocalPool a -> a -> IO ()
forall a. Pool a -> LocalPool a -> a -> IO ()
P.destroyResource Pool a
pool LocalPool a
localPool a
a

putResource :: MonadUnliftIO m => LocalPool a -> a -> m ()
putResource :: forall (m :: * -> *) a. MonadUnliftIO m => LocalPool a -> a -> m ()
putResource LocalPool a
localPool a
a = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LocalPool a -> a -> IO ()
forall a. LocalPool a -> a -> IO ()
P.putResource LocalPool a
localPool a
a

destroyAllResources :: MonadUnliftIO m => Pool a -> m ()
destroyAllResources :: forall (m :: * -> *) a. MonadUnliftIO m => Pool a -> m ()
destroyAllResources Pool a
pool = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Pool a -> IO ()
forall a. Pool a -> IO ()
P.destroyAllResources Pool a
pool