{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Control.Concurrent.Thread.Finalizers
  ( mkWeakThreadIdWithFinalizer
  , addThreadFinalizer
  , finalizeThread
  ) where
import Control.Concurrent
import Control.Exception
import Control.Monad ( void )
import GHC.IO (IO(..))
import GHC.Prim ( mkWeak# )
import GHC.Weak ( Weak(..), finalize )
import GHC.Conc.Sync ( ThreadId(..) )

-- | A variant of 'Control.Concurrent.mkWeakThreadId' that supports
-- finalization.
--
-- Make a weak pointer to a 'ThreadId'.  It can be important to do
-- this if you want to hold a reference to a 'ThreadId' while still
-- allowing the thread to receive the @BlockedIndefinitely@ family of
-- exceptions (e.g. 'BlockedIndefinitelyOnMVar').  Holding a normal
-- 'ThreadId' reference will prevent the delivery of
-- @BlockedIndefinitely@ exceptions because the reference could be
-- used as the target of 'throwTo' at any time, which would unblock
-- the thread.
--
-- Holding a @Weak ThreadId@, on the other hand, will not prevent the
-- thread from receiving @BlockedIndefinitely@ exceptions.  It is
-- still possible to throw an exception to a @Weak ThreadId@, but the
-- caller must use @deRefWeak@ first to determine whether the thread
-- still exists.
--
mkWeakThreadIdWithFinalizer :: ThreadId -> IO () -> IO (Weak ThreadId)
mkWeakThreadIdWithFinalizer :: ThreadId -> IO () -> IO (Weak ThreadId)
mkWeakThreadIdWithFinalizer t :: ThreadId
t@(ThreadId ThreadId#
t#) (IO State# RealWorld -> (# State# RealWorld, () #)
finalizer) = forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case mkWeak# :: forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# ThreadId#
t# ThreadId
t State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of
    (# State# RealWorld
s1, Weak# ThreadId
w #) -> (# State# RealWorld
s1, forall v. Weak# v -> Weak v
Weak Weak# ThreadId
w #)

{-|
  A specialised version of 'mkWeakThreadIdWithFinalizer', where the 'Weak' object
  returned is simply thrown away (however the finalizer will be
  remembered by the garbage collector, and will still be run
  when the key becomes unreachable).
-}
addThreadFinalizer :: ThreadId -> IO () -> IO ()
addThreadFinalizer :: ThreadId -> IO () -> IO ()
addThreadFinalizer ThreadId
tid IO ()
m = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ThreadId -> IO () -> IO (Weak ThreadId)
mkWeakThreadIdWithFinalizer ThreadId
tid IO ()
m

{-|
  Run a thread's finalizers. This is just a convenience alias for 'System.Mem.Weak.finalize'.

  The thread can still be used afterwards, it will simply not run the associated finalizers again.
-}
finalizeThread :: Weak ThreadId -> IO ()
finalizeThread :: Weak ThreadId -> IO ()
finalizeThread = forall v. Weak v -> IO ()
finalize