module Streamly.Internal.Data.IOFinalizer.Lifted
(
IOFinalizer
, newIOFinalizer
, runIOFinalizer
, clearingIOFinalizer
)
where
import Control.Exception (mask_)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef, IORef)
import Streamly.Internal.Control.Concurrent
(MonadRunInIO, askRunInIO, runInIO, withRunInIO)
import Streamly.Internal.Data.IOFinalizer (IOFinalizer(..), runIOFinalizer)
mkIOFinalizer :: MonadRunInIO m => m b -> m (IO ())
mkIOFinalizer :: forall (m :: * -> *) b. MonadRunInIO m => m b -> m (IO ())
mkIOFinalizer m b
f = do
RunInIO m
mrun <- m (RunInIO m)
forall (m :: * -> *). MonadRunInIO m => m (RunInIO m)
askRunInIO
IO () -> m (IO ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> m (IO ())) -> IO () -> m (IO ())
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StM m b
_ <- RunInIO m -> forall b. m b -> IO (StM m b)
forall (m :: * -> *). RunInIO m -> forall b. m b -> IO (StM m b)
runInIO RunInIO m
mrun m b
f
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runFinalizerGC :: IORef (Maybe (IO ())) -> IO ()
runFinalizerGC :: IORef (Maybe (IO ())) -> IO ()
runFinalizerGC IORef (Maybe (IO ()))
ref = do
Maybe (IO ())
res <- IORef (Maybe (IO ())) -> IO (Maybe (IO ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (IO ()))
ref
case Maybe (IO ())
res of
Maybe (IO ())
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just IO ()
f -> IO ()
f
newIOFinalizer :: MonadRunInIO m => m a -> m IOFinalizer
newIOFinalizer :: forall (m :: * -> *) a. MonadRunInIO m => m a -> m IOFinalizer
newIOFinalizer m a
finalizer = do
IO ()
f <- m a -> m (IO ())
forall (m :: * -> *) b. MonadRunInIO m => m b -> m (IO ())
mkIOFinalizer m a
finalizer
IORef (Maybe (IO ()))
ref <- IO (IORef (Maybe (IO ()))) -> m (IORef (Maybe (IO ())))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (IO ()))) -> m (IORef (Maybe (IO ()))))
-> IO (IORef (Maybe (IO ()))) -> m (IORef (Maybe (IO ())))
forall a b. (a -> b) -> a -> b
$ Maybe (IO ()) -> IO (IORef (Maybe (IO ())))
forall a. a -> IO (IORef a)
newIORef (Maybe (IO ()) -> IO (IORef (Maybe (IO ()))))
-> Maybe (IO ()) -> IO (IORef (Maybe (IO ())))
forall a b. (a -> b) -> a -> b
$ IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just IO ()
f
Weak (IORef (Maybe (IO ())))
_ <- IO (Weak (IORef (Maybe (IO ()))))
-> m (Weak (IORef (Maybe (IO ()))))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak (IORef (Maybe (IO ()))))
-> m (Weak (IORef (Maybe (IO ())))))
-> IO (Weak (IORef (Maybe (IO ()))))
-> m (Weak (IORef (Maybe (IO ()))))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (IO ())) -> IO () -> IO (Weak (IORef (Maybe (IO ()))))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef (Maybe (IO ()))
ref (IORef (Maybe (IO ())) -> IO ()
runFinalizerGC IORef (Maybe (IO ()))
ref)
IOFinalizer -> m IOFinalizer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOFinalizer -> m IOFinalizer) -> IOFinalizer -> m IOFinalizer
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (IO ())) -> IOFinalizer
IOFinalizer IORef (Maybe (IO ()))
ref
clearingIOFinalizer :: MonadRunInIO m => IOFinalizer -> m a -> m a
clearingIOFinalizer :: forall (m :: * -> *) a. MonadRunInIO m => IOFinalizer -> m a -> m a
clearingIOFinalizer (IOFinalizer IORef (Maybe (IO ()))
ref) m a
action = do
((forall a. m a -> IO (StM m a)) -> IO (StM m a)) -> m a
forall (m :: * -> *) b.
MonadRunInIO m =>
((forall a. m a -> IO (StM m a)) -> IO (StM m b)) -> m b
withRunInIO (((forall a. m a -> IO (StM m a)) -> IO (StM m a)) -> m a)
-> ((forall a. m a -> IO (StM m a)) -> IO (StM m a)) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO (StM m a)
runinio ->
IO (StM m a) -> IO (StM m a)
forall a. IO a -> IO a
mask_ (IO (StM m a) -> IO (StM m a)) -> IO (StM m a) -> IO (StM m a)
forall a b. (a -> b) -> a -> b
$ do
IORef (Maybe (IO ())) -> Maybe (IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (IO ()))
ref Maybe (IO ())
forall a. Maybe a
Nothing
m a -> IO (StM m a)
forall a. m a -> IO (StM m a)
runinio m a
action