-- | Module: Lifetimes.Gc
-- Description: Attach garbage-collector managed finalizers to resources.
--
-- This module integrates the lifetimes package with GHC's finalizers; this
-- allows you to have the GC run cleanup actions when a resource is garbage
-- collected, rather than managing its lifetime explicitly.
--
-- You should think twice before using this; much of the point of this package
-- is to manage resources whose lifetime is *semantically significant*, so
-- in many cases you will want more control over when the resource is released
-- than this module provides. It would be inappropriate to use this
-- if:
--
-- * You need the resource to be cleaned up promptly for semantic reasons
--   (e.g. dropping a network connection).
-- * The resource is scarce (e.g. file descriptors), so it is not safe to
--   wait for the garbage collector to get around it.
--
-- It is sometimes appropriate however, when time of release is mostly an
-- implementation detail. In particular, this module is fine for use cases
-- where you would want to use a finalizer anyway, and it can be safer:
-- The GHC APIs allow you to attach finalizers to arbitrary values, but
-- doing so is perlious; the compiler and runtime system are free to do
-- many transformations on the code that uses pure values, so it is easy
-- to end up with the finalizer being run sooner than you intended. This
-- module provides a 'Cell' type for finalizable values which is easier
-- to reason about.
{-# LANGUAGE NamedFieldPuns #-}
module Lifetimes.Gc
    ( Cell
    , readCell
    , acquireCell
    , moveToGc
    , newCell
    , addFinalizer
    ) where

import Control.Concurrent.MVar (MVar, mkWeakMVar, newEmptyMVar)
import Control.Concurrent.STM
import Control.Exception       (mask)
import Control.Monad.STM.Class
import Lifetimes
import Zhp

-- | A cell, containing a value with possible finalizers attached. This differs
-- from 'Resource' in that getting the underlying value cannot fail, since
-- cleanup is controlled by the garbage collector.
newtype Cell a
    = Cell (TVar (CellData a))
    deriving(Cell a -> Cell a -> Bool
(Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Bool) -> Eq (Cell a)
forall a. Cell a -> Cell a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell a -> Cell a -> Bool
$c/= :: forall a. Cell a -> Cell a -> Bool
== :: Cell a -> Cell a -> Bool
$c== :: forall a. Cell a -> Cell a -> Bool
Eq)

-----------------------------------------------------------------------
-- Implementation notes:
--
-- From the docs for the 'Weak' type:
--
-- > WARNING: weak pointers to ordinary non-primitive Haskell types
-- > are particularly fragile, because the compiler is free to optimise
-- > away or duplicate the underlying data structure. Therefore
-- > attempting to place a finalizer on an ordinary Haskell type may
-- > well result in the finalizer running earlier than you expected.
-- >
-- > [...]
-- >
-- > Finalizers can be used reliably for types that are created
-- > explicitly and have identity, such as IORef and MVar. [...]
--
-- So instead, we provide a 'Cell' type, which:
--
-- * Wraps simple value
-- * Can be created and read inside STM, and
-- * May safely have finalizers, using the 'addFinalizer' function in
--   this module.
-- * Ensures that the finalizers will not be run before any transaction that
--   reads data is complete.
--
-- Note that it is *not* safe to use the primitives from "Sys.Mem.Weak" to
-- add finalizers.
-----------------------------------------------------------------------

-- The actual contents of a cell. This is wrapped in a 'TVar' to force accesses
-- to add the a reference the transaction log from which the finalizers are
-- reachable, thus preventing them from running before the completion of any
-- transaction that examines the value.
data CellData a = CellData
    { CellData a -> a
value      :: a
    -- ^ The value wrapped by the cell.

    , CellData a -> [MVar ()]
finalizers :: [MVar ()]
    -- ^ Experimentally, TVars appear not to be safe for finalizers, so
    -- instead we create MVars for the finalizers, and store them in this
    -- list so that we maintain a reference to them.
    }
    deriving(CellData a -> CellData a -> Bool
(CellData a -> CellData a -> Bool)
-> (CellData a -> CellData a -> Bool) -> Eq (CellData a)
forall a. Eq a => CellData a -> CellData a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellData a -> CellData a -> Bool
$c/= :: forall a. Eq a => CellData a -> CellData a -> Bool
== :: CellData a -> CellData a -> Bool
$c== :: forall a. Eq a => CellData a -> CellData a -> Bool
Eq)

-- | Get the value from a cell. The value will not be collected until after
-- the all transactions which read it complete.
--
-- Note that this is intentionally not in 'MonadSTM': it is unsafe to use it
-- in 'IO', since the transaction would be finished as soon as it is read.
-- Instead, in 'IO' you should use acquireCell
readCell :: Cell a -> STM a
readCell :: Cell a -> STM a
readCell (Cell TVar (CellData a)
state) = CellData a -> a
forall a. CellData a -> a
value (CellData a -> a) -> STM (CellData a) -> STM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (CellData a) -> STM (CellData a)
forall a. TVar a -> STM a
readTVar TVar (CellData a)
state

-- | Create  a new cell, initially with no finalizers.
newCell :: MonadSTM m => a -> m (Cell a)
newCell :: a -> m (Cell a)
newCell a
value = STM (Cell a) -> m (Cell a)
forall (m :: * -> *) a. MonadSTM m => STM a -> m a
liftSTM (STM (Cell a) -> m (Cell a)) -> STM (Cell a) -> m (Cell a)
forall a b. (a -> b) -> a -> b
$ TVar (CellData a) -> Cell a
forall a. TVar (CellData a) -> Cell a
Cell (TVar (CellData a) -> Cell a)
-> STM (TVar (CellData a)) -> STM (Cell a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellData a -> STM (TVar (CellData a))
forall a. a -> STM (TVar a)
newTVar CellData :: forall a. a -> [MVar ()] -> CellData a
CellData { a
value :: a
value :: a
value, finalizers :: [MVar ()]
finalizers = [] }

-- | Add a new finalizer to the cell. Cells may have many finalizers
-- attached.
addFinalizer :: Cell a -> IO () -> IO ()
addFinalizer :: Cell a -> IO () -> IO ()
addFinalizer (Cell TVar (CellData a)
stateVar) IO ()
fin = do
    MVar ()
mvar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    Weak (MVar ())
_ <- MVar () -> IO () -> IO (Weak (MVar ()))
forall a. MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar MVar ()
mvar IO ()
fin
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (CellData a) -> (CellData a -> CellData a) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (CellData a)
stateVar ((CellData a -> CellData a) -> STM ())
-> (CellData a -> CellData a) -> STM ()
forall a b. (a -> b) -> a -> b
$ \state :: CellData a
state@CellData{[MVar ()]
finalizers :: [MVar ()]
finalizers :: forall a. CellData a -> [MVar ()]
finalizers} ->
        CellData a
state { finalizers :: [MVar ()]
finalizers = MVar ()
mvar MVar () -> [MVar ()] -> [MVar ()]
forall a. a -> [a] -> [a]
: [MVar ()]
finalizers }

-- | Move a resource to the garbage collector, detaching it from its
-- original lifetime.
moveToGc :: Resource a -> IO (Cell a)
moveToGc :: Resource a -> IO (Cell a)
moveToGc Resource a
r =
    ((forall a. IO a -> IO a) -> IO (Cell a)) -> IO (Cell a)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Cell a)) -> IO (Cell a))
-> ((forall a. IO a -> IO a) -> IO (Cell a)) -> IO (Cell a)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_ -> IO (IO (Cell a)) -> IO (Cell a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO (Cell a)) -> IO (Cell a))
-> IO (IO (Cell a)) -> IO (Cell a)
forall a b. (a -> b) -> a -> b
$ STM (IO (Cell a)) -> IO (IO (Cell a))
forall a. STM a -> IO a
atomically (STM (IO (Cell a)) -> IO (IO (Cell a)))
-> STM (IO (Cell a)) -> IO (IO (Cell a))
forall a b. (a -> b) -> a -> b
$ do
        a
value <- Resource a -> STM a
forall (m :: * -> *) a. MonadSTM m => Resource a -> m a
mustGetResource Resource a
r
        IO ()
fin <- Resource a -> STM (IO ())
forall (m :: * -> *) a. MonadSTM m => Resource a -> m (IO ())
detach Resource a
r
        Cell a
cell <- a -> STM (Cell a)
forall (m :: * -> *) a. MonadSTM m => a -> m (Cell a)
newCell a
value
        IO (Cell a) -> STM (IO (Cell a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (Cell a) -> STM (IO (Cell a)))
-> IO (Cell a) -> STM (IO (Cell a))
forall a b. (a -> b) -> a -> b
$ do
            Cell a -> IO () -> IO ()
forall a. Cell a -> IO () -> IO ()
addFinalizer Cell a
cell IO ()
fin
            Cell a -> IO (Cell a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cell a
cell


-- | Acquire a reference to the underlying value. This keeps the finalizer
-- from being run before the acquired reference is dropped.
--
-- If you need to use the value in 'IO', you should use this to get a
-- reference to it. If you only need to use it in 'STM', 'readCell'
-- may be more ergonomic.
acquireCell :: Cell a -> Acquire a
acquireCell :: Cell a -> Acquire a
acquireCell (Cell TVar (CellData a)
var) = IO a -> (a -> IO ()) -> Acquire a
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire
    (STM a -> IO a
forall a. STM a -> IO a
atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ CellData a -> a
forall a. CellData a -> a
value (CellData a -> a) -> STM (CellData a) -> STM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (CellData a) -> STM (CellData a)
forall a. TVar a -> STM a
readTVar TVar (CellData a)
var)
    (\a
_ -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- Touch the contents of the cell, to make sure it stays alive.
        CellData{} <- TVar (CellData a) -> STM (CellData a)
forall a. TVar a -> STM a
readTVar TVar (CellData a)
var
        () -> STM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    )