@@ -3169,39 +3169,64 @@ gbracket_ bef exc aft fexc fnormal =
3169 Skip s -> return $ Skip (GBracketException (Stream step1 s))
3169 Skip s -> return $ Skip (GBracketException (Stream step1 s))
3170 Stop -> return Stop
3170 Stop -> return Stop
3172+------------------------------------------------------------------------------
3174+------------------------------------------------------------------------------
3176+-- | Make a finalizer from a monadic action @m a@ that can run in IO monad.
3177+mkIOFinalizer :: MonadBaseControl IO m => m b -> m (IO ())
3178+mkIOFinalizer f = do
3179+ mrun <- captureMonadState
3182+ _ <- runInIO mrun f
3185+-- | Run an IO action stored in a finalized IORef.
3186+runIORefFinalizerGC :: IORef (Maybe (IO ())) -> IO ()
3187+runIORefFinalizerGC ref = do
3188+ res <- readIORef ref
3190+ Nothing -> return ()
3172−-- | Create an IORef holding a finalizer that is called automatically when the
3193+-- | Create an IORef holding a finalizer that is called automatically when
3173−-- IORef is garbage collected. The IORef can be written to with a 'Nothing'
3194+-- the IORef is garbage collected. The IORef can be written to with a 'Nothing'
3174-- value to deactivate the finalizer.
3195-- value to deactivate the finalizer.
3197+-- Note: The finalizer is always run with the state of the monad captured at
3198+-- the time of calling newFinalizedIORef. To run it on garbage collection we
3199+-- have no option but to take a snapshot of the monadic state at some point of
3200+-- time. For normal case we could run it with the current state of the monad
3201+-- but we want to keep both the cases consistent.
3175newFinalizedIORef :: (MonadIO m, MonadBaseControl IO m)
3203newFinalizedIORef :: (MonadIO m, MonadBaseControl IO m)
3176 => m a -> m (IORef (Maybe (IO ())))
3204 => m a -> m (IORef (Maybe (IO ())))
3177newFinalizedIORef finalizer = do
3205newFinalizedIORef finalizer = do
3178− mrun <- captureMonadState
3179− ref <- liftIO $ newIORef $ Just $ liftIO $ void $ do
3180− _ <- runInIO mrun finalizer
3206+ f <- mkIOFinalizer finalizer
3181− return ()
3207+ ref <- liftIO $ newIORef $ Just f
3182− let finalizer1 = do
3183− res <- readIORef ref
3185− Nothing -> return ()
3187− _ <- liftIO $ mkWeakIORef ref finalizer1
3208+ _ <- liftIO $ mkWeakIORef ref (runIORefFinalizerGC ref)
3188 return ref
3209 return ref
3190-- | Run the finalizer stored in an IORef and deactivate it so that it is run
3211-- | Run the finalizer stored in an IORef and deactivate it so that it is run
3191−-- only once.
3212+-- only once. Note, the action runs with async exceptions masked.
3193runIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()
3214runIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()
3194runIORefFinalizer ref = liftIO $ do
3215runIORefFinalizer ref = liftIO $ do
3195 res <- readIORef ref
3216 res <- readIORef ref
3196 case res of
3217 case res of
3197 Nothing -> return ()
3218 Nothing -> return ()
3198− Just f -> writeIORef ref Nothing >> f
3220+ writeIORef ref Nothing
3200-- | Deactivate the finalizer stored in an IORef without running it.
3223-- | Deactivate the finalizer stored in an IORef without running it.
3202clearIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()
3225clearIORefFinalizer :: MonadIO m => IORef (Maybe (IO ())) -> m ()
3203clearIORefFinalizer ref = liftIO $ writeIORef ref Nothing
3226clearIORefFinalizer ref = liftIO $ writeIORef ref Nothing
3228+------------------------------------------------------------------------------
3205data GbracketIOState s1 s2 v wref
3230data GbracketIOState s1 s2 v wref
3206 = GBracketIOInit
3231 = GBracketIOInit
3207 | GBracketIONormal s1 v wref
3232 | GBracketIONormal s1 v wref