module Data.Conduit.Pool
( ManagedResource (..)
, takeResource
, takeResourceCheck
, P.Pool
, P.createPool
, P.withResource
) where
import qualified Data.Pool as P
import Control.Monad.Trans.Resource
import Control.Monad.IO.Class (liftIO)
import qualified Data.IORef as I
data ManagedResource m a = ManagedResource
{ mrValue :: a
, mrReuse :: Bool -> m ()
, mrRelease :: m ()
}
takeResource :: MonadResource m => P.Pool a -> m (ManagedResource m a)
takeResource pool = do
onRelRef <- liftIO $ I.newIORef False
(relKey, (a, _)) <- allocate
(P.takeResource pool)
(\(a, local) -> do
onRel <- I.readIORef onRelRef
if onRel
then P.putResource local a
else P.destroyResource pool local a)
return ManagedResource
{ mrValue = a
, mrReuse = liftIO . I.writeIORef onRelRef
, mrRelease = release relKey
}
takeResourceCheck :: MonadResource m
=> P.Pool a
-> (a -> m Bool)
-> m (ManagedResource m a)
takeResourceCheck pool check = do
mr <- takeResource pool
isValid <- check $ mrValue mr
if isValid
then return mr
else do
mrRelease mr
takeResourceCheck pool check