    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE RecursiveDo #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-----------------------------------------------------------------------------
        reactive-banana
    ------------------------------------------------------------------------------}
    module Reactive.Banana.Prim.Low.Ref
        ( -- * Mutable references with 'Unique'
          Ref
        , getUnique
        , new
        , equal
        , read
        , put
        , modify'

          -- * Garbage collection and weak pointers to 'Ref'
        , addFinalizer
        , getWeakRef

        , WeakRef
        , mkWeak
        , deRefWeak
        , deRefWeaks
        , finalize
        ) where

    import Prelude hiding ( read )

    import Control.DeepSeq
        ( NFData (..) )
    import Control.Monad
        ( void )
    import Control.Monad.IO.Class
        ( MonadIO (liftIO) )
    import Data.Hashable
        ( Hashable (..) )
    import Data.IORef
        ( IORef, newIORef, readIORef, writeIORef )
    import Data.Maybe
        ( catMaybes )
    import Data.Unique.Really
        ( Unique, newUnique )

    import qualified System.Mem.Weak as Weak
    import qualified GHC.Base as GHC
    import qualified GHC.IORef as GHC
    import qualified GHC.STRef as GHC
    import qualified GHC.Weak as GHC

    {-----------------------------------------------------------------------------
        Ref
    ------------------------------------------------------------------------------}
    -- | A mutable reference which has a 'Unique' associated with it.
    data Ref a = Ref
        !Unique         -- Unique associated to the 'Ref'
        !(IORef a)      -- 'IORef' that stores the value of type 'a'
        !(WeakRef a)    -- For convenience, a weak pointer to itself

    instance NFData (Ref a) where rnf :: Ref a -> ()
    rnf (Ref Unique
    _ IORef a
    _ WeakRef a
    _) = ()

    instance Eq (Ref a) where == :: Ref a -> Ref a -> Bool
    (==) = Ref a -> Ref a -> Bool
    forall a b. Ref a -> Ref b -> Bool
    equal

    instance Hashable (Ref a) where hashWithSalt :: Int -> Ref a -> Int
    hashWithSalt Int
    s (Ref Unique
    u IORef a
    _ WeakRef a
    _) = Int -> Unique -> Int
    forall a. Hashable a => Int -> a -> Int
    hashWithSalt Int
    s Unique
    u

    getUnique :: Ref a -> Unique
    getUnique :: forall a. Ref a -> Unique
    getUnique (Ref Unique
    u IORef a
    _ WeakRef a
    _) = Unique
    u

    getWeakRef :: Ref a -> WeakRef a
    getWeakRef :: forall a. Ref a -> WeakRef a
    getWeakRef (Ref Unique
    _ IORef a
    _ WeakRef a
    w) = WeakRef a
    w

    equal :: Ref a -> Ref b -> Bool
    equal :: forall a b. Ref a -> Ref b -> Bool
    equal (Ref Unique
    ua IORef a
    _ WeakRef a
    _) (Ref Unique
    ub IORef b
    _ WeakRef b
    _) = Unique
    ua Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unique
    ub

    new :: MonadIO m => a -> m (Ref a)
    new :: forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
    new a
    a = IO (Ref a) -> m (Ref a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Ref a) -> m (Ref a)) -> IO (Ref a) -> m (Ref a)
    forall a b. (a -> b) -> a -> b
    $ mdo
        ra     <- a -> IO (IORef a)
    forall a. a -> IO (IORef a)
    newIORef a
    a
        result <- Ref <$> newUnique <*> pure ra <*> pure wa
        wa     <- mkWeakIORef ra result Nothing
        pure result

    read :: MonadIO m => Ref a -> m a
    read :: forall (m :: * -> *) a. MonadIO m => Ref a -> m a
    read ~(Ref Unique
    _ IORef a
    r WeakRef a
    _) = IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    r

    put :: MonadIO m => Ref a -> a -> m ()
    put :: forall (m :: * -> *) a. MonadIO m => Ref a -> a -> m ()
    put ~(Ref Unique
    _ IORef a
    r WeakRef a
    _) = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    r

    -- | Strictly modify a 'Ref'.
    modify' :: MonadIO m => Ref a -> (a -> a) -> m ()
    modify' :: forall (m :: * -> *) a. MonadIO m => Ref a -> (a -> a) -> m ()
    modify' ~(Ref Unique
    _ IORef a
    r WeakRef a
    _) a -> a
    f = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $
        IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    r IO a -> (a -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    x -> IORef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef a
    r (a -> IO ()) -> a -> IO ()
    forall a b. (a -> b) -> a -> b
    $! a -> a
    f a
    x

    {-----------------------------------------------------------------------------
        Weak pointers
    ------------------------------------------------------------------------------}
    -- | Add a finalizer to a 'Ref'.
    --
    -- See 'System.Mem.Weak.addFinalizer'.
    addFinalizer :: Ref v -> IO () -> IO ()
    addFinalizer :: forall v. Ref v -> IO () -> IO ()
    addFinalizer (Ref Unique
    _ IORef v
    r WeakRef v
    _) = IO (Weak ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Weak ()) -> IO ())
    -> (IO () -> IO (Weak ())) -> IO () -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef v -> () -> Maybe (IO ()) -> IO (Weak ())
    forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
    mkWeakIORef IORef v
    r () (Maybe (IO ()) -> IO (Weak ()))
    -> (IO () -> Maybe (IO ())) -> IO () -> IO (Weak ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just

    -- | Weak pointer to a 'Ref'.
    type WeakRef v = Weak.Weak (Ref v)

    -- | Create a weak pointer that associates a key with a value.
    --
    -- See 'System.Mem.Weak.mkWeak'.
    mkWeak
        :: Ref k -- ^ key
        -> v -- ^ value
        -> Maybe (IO ()) -- ^ finalizer
        -> IO (Weak.Weak v)
    mkWeak :: forall k v. Ref k -> v -> Maybe (IO ()) -> IO (Weak v)
    mkWeak (Ref Unique
    _ IORef k
    r WeakRef k
    _) = IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
    forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
    mkWeakIORef IORef k
    r

    -- | Finalize a 'WeakRef'.
    --
    -- See 'System.Mem.Weak.finalize'.
    finalize :: WeakRef v -> IO ()
    finalize :: forall v. WeakRef v -> IO ()
    finalize = Weak (Ref v) -> IO ()
    forall v. Weak v -> IO ()
    Weak.finalize

    -- | Dereference a 'WeakRef'.
    --
    -- See 'System.Mem.Weak.deRefWeak'.
    deRefWeak :: Weak.Weak v -> IO (Maybe v)
    deRefWeak :: forall v. Weak v -> IO (Maybe v)
    deRefWeak = Weak v -> IO (Maybe v)
    forall v. Weak v -> IO (Maybe v)
    Weak.deRefWeak

    -- | Dereference a list of weak pointers while discarding dead ones.
    deRefWeaks :: [Weak.Weak v] -> IO [v]
    deRefWeaks :: forall v. [Weak v] -> IO [v]
    deRefWeaks [Weak v]
    ws = [Maybe v] -> [v]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe v] -> [v]) -> IO [Maybe v] -> IO [v]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Weak v -> IO (Maybe v)) -> [Weak v] -> IO [Maybe v]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Weak v -> IO (Maybe v)
    forall v. Weak v -> IO (Maybe v)
    Weak.deRefWeak [Weak v]
    ws

    {-----------------------------------------------------------------------------
        Helpers
    ------------------------------------------------------------------------------}
    -- | Create a weak pointer to an 'IORef'.
    --
    -- Unpacking the constructors (e.g. 'GHC.IORef' etc.) is necessary
    -- because the constructors may be unpacked while the 'IORef' is used
    -- — so, the value contained therein is alive, but the constructors are not.
    mkWeakIORef
        :: IORef k -- ^ key
        -> v       -- ^ value
        -> Maybe (IO ()) -- ^ finalizer
        -> IO (Weak.Weak v)
    mkWeakIORef :: forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
    mkWeakIORef (GHC.IORef (GHC.STRef MutVar# RealWorld k
    r#)) v
    v (Just (GHC.IO State# RealWorld -> (# State# RealWorld, () #)
    finalizer)) =
        (State# RealWorld -> (# State# RealWorld, Weak v #)) -> IO (Weak v)
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    GHC.IO ((State# RealWorld -> (# State# RealWorld, Weak v #))
     -> IO (Weak v))
    -> (State# RealWorld -> (# State# RealWorld, Weak v #))
    -> IO (Weak v)
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    s -> case MutVar# RealWorld k
    -> v
    -> (State# RealWorld -> (# State# RealWorld, () #))
    -> State# RealWorld
    -> (# State# RealWorld, Weak# v #)
    forall a b c.
    a
    -> b
    -> (State# RealWorld -> (# State# RealWorld, c #))
    -> State# RealWorld
    -> (# State# RealWorld, Weak# b #)
    GHC.mkWeak# MutVar# RealWorld k
    r# v
    v State# RealWorld -> (# State# RealWorld, () #)
    finalizer State# RealWorld
    s of
            (# State# RealWorld
    s1, Weak# v
    w #) -> (# State# RealWorld
    s1, Weak# v -> Weak v
    forall v. Weak# v -> Weak v
    GHC.Weak Weak# v
    w #)
    mkWeakIORef (GHC.IORef (GHC.STRef MutVar# RealWorld k
    r#)) v
    v Maybe (IO ())
    Nothing =
        (State# RealWorld -> (# State# RealWorld, Weak v #)) -> IO (Weak v)
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    GHC.IO ((State# RealWorld -> (# State# RealWorld, Weak v #))
     -> IO (Weak v))
    -> (State# RealWorld -> (# State# RealWorld, Weak v #))
    -> IO (Weak v)
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    s -> case MutVar# RealWorld k
    -> v -> State# RealWorld -> (# State# RealWorld, Weak# v #)
    forall a b.
    a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
    GHC.mkWeakNoFinalizer# MutVar# RealWorld k
    r# v
    v State# RealWorld
    s of
            (# State# RealWorld
    s1, Weak# v
    w #) -> (# State# RealWorld
    s1, Weak# v -> Weak v
    forall v. Weak# v -> Weak v
    GHC.Weak Weak# v
    w #)