-- | -- Module : Streamly.Internal.Data.IOFinalizer.Lifted -- Copyright : (c) 2020 Composewell Technologies and Contributors -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -- -- A value associated with an IO action that is automatically called whenever -- the value is garbage collected. 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) -- | Make a finalizer from a monadic action @m a@ that can run in IO monad. 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 () -- | GC hook to run an IO action stored in a finalized IORef. 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 -- | Create a finalizer that calls the supplied function automatically when the -- it is garbage collected. -- -- /The finalizer is always run using the state of the monad that is captured -- at the time of calling 'newFinalizer'./ -- -- Note: To run it on garbage collection we have no option but to use the monad -- state captured at some earlier point of time. For the case when the -- finalizer is run manually before GC we could run it with the current state -- of the monad but we want to keep both the cases consistent. -- -- /Pre-release/ 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 -- | Run an action clearing the finalizer atomically wrt async exceptions. The -- action is run with async exceptions masked. -- -- /Pre-release/ 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