module UnliftIO.Pool
  ( Pool
  , LocalPool
  , createPool
  , withResource
  , takeResource
  , tryWithResource
  , tryTakeResource
  , destroyResource
  , putResource
  , destroyAllResources
  ) where

import           Control.Monad.IO.Unlift (MonadUnliftIO(..), liftIO)
import qualified Data.Pool as P
import           Data.Time.Clock (NominalDiffTime)

type Pool = P.Pool

type LocalPool = P.LocalPool

createPool :: MonadUnliftIO m => m a -> (a -> m ()) -> Int -> NominalDiffTime -> Int -> m (Pool a)
createPool :: m a -> (a -> m ()) -> Int -> NominalDiffTime -> Int -> m (Pool a)
createPool m a
create a -> m ()
destroy Int
stripes NominalDiffTime
keepAlive Int
maxPerStripe =
  ((forall a. m a -> IO a) -> IO (Pool a)) -> m (Pool a)
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 (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
$ IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
P.createPool (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) Int
stripes NominalDiffTime
keepAlive Int
maxPerStripe

withResource :: MonadUnliftIO m => Pool a -> (a -> m b) -> m b
withResource :: 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 (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 (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 :: Pool a -> m (a, LocalPool a)
takeResource Pool a
pool = IO (a, LocalPool a) -> m (a, LocalPool 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 :: 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 (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 (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 :: Pool a -> m (Maybe (a, LocalPool a))
tryTakeResource Pool a
pool = IO (Maybe (a, LocalPool a)) -> m (Maybe (a, LocalPool 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 :: Pool a -> LocalPool a -> a -> m ()
destroyResource Pool a
pool LocalPool a
localPool a
a = IO () -> m ()
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 :: LocalPool a -> a -> m ()
putResource LocalPool a
localPool a
a = IO () -> m ()
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 :: Pool a -> m ()
destroyAllResources Pool a
pool = IO () -> m ()
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