{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ConstraintKinds #-}
module Control.Monad.Trans.Resource
(
ResourceT
, ResIO
, ReleaseKey
, runResourceT
, runResourceTChecked
, ResourceCleanupException (..)
, resourceForkWith
, resourceForkIO
, transResourceT
, joinResourceT
, allocate
, allocate_
, register
, release
, unprotect
, resourceMask
, MonadResource (..)
, MonadResourceBase
, InvalidAccess (..)
, MonadUnliftIO
, InternalState
, getInternalState
, runInternalState
, withInternalState
, createInternalState
, closeInternalState
, MonadThrow (..)
) where
import qualified Data.IntMap as IntMap
import qualified Data.IORef as I
import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)
import qualified Control.Exception as E
import Control.Monad.Trans.Resource.Internal
import Control.Concurrent (ThreadId, forkIO)
import Control.Monad.Catch (MonadThrow, throwM)
import Data.Acquire.Internal (ReleaseType (..))
register :: MonadResource m => IO () -> m ReleaseKey
register :: forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register = forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ResourceT IO ReleaseKey
registerRIO
release :: MonadIO m => ReleaseKey -> m ()
release :: forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release (ReleaseKey IORef ReleaseMap
istate Int
rk) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a) -> IO a
release' IORef ReleaseMap
istate Int
rk
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a. a -> a
id)
unprotect :: MonadIO m => ReleaseKey -> m (Maybe (IO ()))
unprotect :: forall (m :: * -> *). MonadIO m => ReleaseKey -> m (Maybe (IO ()))
unprotect (ReleaseKey IORef ReleaseMap
istate Int
rk) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a) -> IO a
release' IORef ReleaseMap
istate Int
rk forall (m :: * -> *) a. Monad m => a -> m a
return
allocate :: MonadResource m
=> IO a
-> (a -> IO ())
-> m (ReleaseKey, a)
allocate :: forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate IO a
a = forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a)
allocateRIO IO a
a
allocate_ :: MonadResource m
=> IO a
-> IO ()
-> m ReleaseKey
allocate_ :: forall (m :: * -> *) a.
MonadResource m =>
IO a -> IO () -> m ReleaseKey
allocate_ IO a
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate IO a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
resourceMask :: MonadResource m => ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> m b
resourceMask :: forall (m :: * -> *) b.
MonadResource m =>
((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b)
-> m b
resourceMask (forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b
r = forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT (forall b.
((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b)
-> ResourceT IO b
resourceMaskRIO (forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b
r)
allocateRIO :: IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a)
allocateRIO :: forall a. IO a -> (a -> IO ()) -> ResourceT IO (ReleaseKey, a)
allocateRIO IO a
acquire a -> IO ()
rel = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
istate -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ do
a
a <- IO a
acquire
ReleaseKey
key <- IORef ReleaseMap -> IO () -> IO ReleaseKey
register' IORef ReleaseMap
istate forall a b. (a -> b) -> a -> b
$ a -> IO ()
rel a
a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReleaseKey
key, a
a)
registerRIO :: IO () -> ResourceT IO ReleaseKey
registerRIO :: IO () -> ResourceT IO ReleaseKey
registerRIO IO ()
rel = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
istate -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IORef ReleaseMap -> IO () -> IO ReleaseKey
register' IORef ReleaseMap
istate IO ()
rel
resourceMaskRIO :: ((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b) -> ResourceT IO b
resourceMaskRIO :: forall b.
((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b)
-> ResourceT IO b
resourceMaskRIO (forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b
f = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
istate -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
let ResourceT IORef ReleaseMap -> IO b
f' = (forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b
f ((forall a. IO a -> IO a)
-> forall a. ResourceT IO a -> ResourceT IO a
go forall a. IO a -> IO a
restore)
in IORef ReleaseMap -> IO b
f' IORef ReleaseMap
istate
where
go :: (forall a. IO a -> IO a) -> (forall a. ResourceT IO a -> ResourceT IO a)
go :: (forall a. IO a -> IO a)
-> forall a. ResourceT IO a -> ResourceT IO a
go forall a. IO a -> IO a
r (ResourceT IORef ReleaseMap -> IO a
g) = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT (\IORef ReleaseMap
i -> forall a. IO a -> IO a
r (IORef ReleaseMap -> IO a
g IORef ReleaseMap
i))
release' :: I.IORef ReleaseMap
-> Int
-> (Maybe (IO ()) -> IO a)
-> IO a
release' :: forall a.
IORef ReleaseMap -> Int -> (Maybe (IO ()) -> IO a) -> IO a
release' IORef ReleaseMap
istate Int
key Maybe (IO ()) -> IO a
act = forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ do
Maybe (IO ())
maction <- forall a b. IORef a -> (a -> (a, b)) -> IO b
I.atomicModifyIORef IORef ReleaseMap
istate ReleaseMap -> (ReleaseMap, Maybe (IO ()))
lookupAction
Maybe (IO ()) -> IO a
act Maybe (IO ())
maction
where
lookupAction :: ReleaseMap -> (ReleaseMap, Maybe (IO ()))
lookupAction rm :: ReleaseMap
rm@(ReleaseMap Int
next RefCount
rf IntMap (ReleaseType -> IO ())
m) =
case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
key IntMap (ReleaseType -> IO ())
m of
Maybe (ReleaseType -> IO ())
Nothing -> (ReleaseMap
rm, forall a. Maybe a
Nothing)
Just ReleaseType -> IO ()
action ->
( Int -> RefCount -> IntMap (ReleaseType -> IO ()) -> ReleaseMap
ReleaseMap Int
next RefCount
rf forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
key IntMap (ReleaseType -> IO ())
m
, forall a. a -> Maybe a
Just (ReleaseType -> IO ()
action ReleaseType
ReleaseEarly)
)
lookupAction ReleaseMap
ReleaseMapClosed = (ReleaseMap
ReleaseMapClosed, forall a. Maybe a
Nothing)
runResourceT :: MonadUnliftIO m => ResourceT m a -> m a
runResourceT :: forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IORef ReleaseMap -> m a
r) = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
IORef ReleaseMap
istate <- forall (m :: * -> *). MonadIO m => m (IORef ReleaseMap)
createInternalState
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
a
res <- forall a. IO a -> IO a
restore (forall a. m a -> IO a
run (IORef ReleaseMap -> m a
r IORef ReleaseMap
istate)) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> do
Maybe SomeException -> IORef ReleaseMap -> IO ()
stateCleanupChecked (forall a. a -> Maybe a
Just SomeException
e) IORef ReleaseMap
istate
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e
Maybe SomeException -> IORef ReleaseMap -> IO ()
stateCleanupChecked forall a. Maybe a
Nothing IORef ReleaseMap
istate
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
runResourceTChecked :: MonadUnliftIO m => ResourceT m a -> m a
runResourceTChecked :: forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceTChecked = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
{-# INLINE runResourceTChecked #-}
bracket_ :: MonadUnliftIO m
=> IO ()
-> IO ()
-> (E.SomeException -> IO ())
-> m a
-> m a
bracket_ :: forall (m :: * -> *) a.
MonadUnliftIO m =>
IO () -> IO () -> (SomeException -> IO ()) -> m a -> m a
bracket_ IO ()
alloc IO ()
cleanupNormal SomeException -> IO ()
cleanupExc m a
inside =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
IO ()
alloc
a
res <- forall a. IO a -> IO a
restore (forall a. m a -> IO a
run m a
inside) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\SomeException
e -> SomeException -> IO ()
cleanupExc SomeException
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e a. Exception e => e -> IO a
E.throwIO SomeException
e)
IO ()
cleanupNormal
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
joinResourceT :: ResourceT (ResourceT m) a
-> ResourceT m a
joinResourceT :: forall (m :: * -> *) a. ResourceT (ResourceT m) a -> ResourceT m a
joinResourceT (ResourceT IORef ReleaseMap -> ResourceT m a
f) = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
r -> forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
unResourceT (IORef ReleaseMap -> ResourceT m a
f IORef ReleaseMap
r) IORef ReleaseMap
r
resourceForkWith
:: MonadUnliftIO m
=> (IO () -> IO a)
-> ResourceT m ()
-> ResourceT m a
resourceForkWith :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(IO () -> IO a) -> ResourceT m () -> ResourceT m a
resourceForkWith IO () -> IO a
g (ResourceT IORef ReleaseMap -> m ()
f) =
forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
r -> forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
forall (m :: * -> *) a.
MonadUnliftIO m =>
IO () -> IO () -> (SomeException -> IO ()) -> m a -> m a
bracket_
(IORef ReleaseMap -> IO ()
stateAlloc IORef ReleaseMap
r)
(forall (m :: * -> *) a. Monad m => a -> m a
return ())
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
(IO () -> IO a
g forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadUnliftIO m =>
IO () -> IO () -> (SomeException -> IO ()) -> m a -> m a
bracket_
(forall (m :: * -> *) a. Monad m => a -> m a
return ())
(ReleaseType -> IORef ReleaseMap -> IO ()
stateCleanup ReleaseType
ReleaseNormal IORef ReleaseMap
r)
(\SomeException
e -> ReleaseType -> IORef ReleaseMap -> IO ()
stateCleanup (SomeException -> ReleaseType
ReleaseExceptionWith SomeException
e) IORef ReleaseMap
r)
(forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ IORef ReleaseMap -> m ()
f IORef ReleaseMap
r))
resourceForkIO :: MonadUnliftIO m => ResourceT m () -> ResourceT m ThreadId
resourceForkIO :: forall (m :: * -> *).
MonadUnliftIO m =>
ResourceT m () -> ResourceT m ThreadId
resourceForkIO = forall (m :: * -> *) a.
MonadUnliftIO m =>
(IO () -> IO a) -> ResourceT m () -> ResourceT m a
resourceForkWith IO () -> IO ThreadId
forkIO
type MonadResourceBase = MonadUnliftIO
{-# DEPRECATED MonadResourceBase "Use MonadUnliftIO directly instead" #-}
createInternalState :: MonadIO m => m InternalState
createInternalState :: forall (m :: * -> *). MonadIO m => m (IORef ReleaseMap)
createInternalState = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
I.newIORef
forall a b. (a -> b) -> a -> b
$ Int -> RefCount -> IntMap (ReleaseType -> IO ()) -> ReleaseMap
ReleaseMap forall a. Bounded a => a
maxBound (forall a. Bounded a => a
minBound forall a. Num a => a -> a -> a
+ RefCount
1) forall a. IntMap a
IntMap.empty
closeInternalState :: MonadIO m => InternalState -> m ()
closeInternalState :: forall (m :: * -> *). MonadIO m => IORef ReleaseMap -> m ()
closeInternalState = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReleaseType -> IORef ReleaseMap -> IO ()
stateCleanup ReleaseType
ReleaseNormal
getInternalState :: Monad m => ResourceT m InternalState
getInternalState :: forall (m :: * -> *). Monad m => ResourceT m (IORef ReleaseMap)
getInternalState = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall (m :: * -> *) a. Monad m => a -> m a
return
type InternalState = I.IORef ReleaseMap
runInternalState :: ResourceT m a -> InternalState -> m a
runInternalState :: forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
runInternalState = forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
unResourceT
withInternalState :: (InternalState -> m a) -> ResourceT m a
withInternalState :: forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
withInternalState = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT