on ffcb268 help sign in
74 lines 2.5 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.IOFinalizer.Lifted
3-- Copyright : (c) 2020 Composewell Technologies and Contributors
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9-- A value associated with an IO action that is automatically called whenever
10-- the value is garbage collected.
12module Streamly.Internal.Data.IOFinalizer.Lifted
13 (
14 IOFinalizer
15 , newIOFinalizer
16 , runIOFinalizer
17 , clearingIOFinalizer
18 )
19where
21import Control.Exception (mask_)
22import Control.Monad (void)
23import Control.Monad.IO.Class (MonadIO(..))
24import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef, IORef)
25import Streamly.Internal.Control.Concurrent
26 (MonadRunInIO, askRunInIO, runInIO, withRunInIO)
27import Streamly.Internal.Data.IOFinalizer (IOFinalizer(..), runIOFinalizer)
29-- | Make a finalizer from a monadic action @m a@ that can run in IO monad.
30mkIOFinalizer :: MonadRunInIO m => m b -> m (IO ())
31mkIOFinalizer f = do
32 mrun <- askRunInIO
33 return $
34 void $ do
35 _ <- runInIO mrun f
36 return ()
38-- | GC hook to run an IO action stored in a finalized IORef.
39runFinalizerGC :: IORef (Maybe (IO ())) -> IO ()
40runFinalizerGC ref = do
41 res <- readIORef ref
42 case res of
43 Nothing -> return ()
44 Just f -> f
46-- | Create a finalizer that calls the supplied function automatically when the
47-- it is garbage collected.
48--
49-- /The finalizer is always run using the state of the monad that is captured
50-- at the time of calling 'newFinalizer'./
51--
52-- Note: To run it on garbage collection we have no option but to use the monad
53-- state captured at some earlier point of time. For the case when the
54-- finalizer is run manually before GC we could run it with the current state
55-- of the monad but we want to keep both the cases consistent.
56--
57-- /Pre-release/
58newIOFinalizer :: MonadRunInIO m => m a -> m IOFinalizer
59newIOFinalizer finalizer = do
60 f <- mkIOFinalizer finalizer
61 ref <- liftIO $ newIORef $ Just f
62 _ <- liftIO $ mkWeakIORef ref (runFinalizerGC ref)
63 return $ IOFinalizer ref
65-- | Run an action clearing the finalizer atomically wrt async exceptions. The
66-- action is run with async exceptions masked.
67--
68-- /Pre-release/
69clearingIOFinalizer :: MonadRunInIO m => IOFinalizer -> m a -> m a
70clearingIOFinalizer (IOFinalizer ref) action = do
71 withRunInIO $ \runinio ->
72 mask_ $ do
73 writeIORef ref Nothing
74 runinio action