{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Reactive.Banana.Prim.Util where
import Control.Monad
import Control.Monad.IO.Class
import Data.Hashable
import Data.IORef
import Data.Maybe (catMaybes)
import Data.Unique.Really
import qualified GHC.Base as GHC
import qualified GHC.IORef as GHC
import qualified GHC.STRef as GHC
import qualified GHC.Weak as GHC
import System.Mem.Weak
debug :: MonadIO m => String -> m ()
debug :: String -> m ()
debug _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nop :: Monad m => m ()
nop :: m ()
nop = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data Ref a = Ref !(IORef a) !Unique
instance Hashable (Ref a) where hashWithSalt :: Int -> Ref a -> Int
hashWithSalt s :: Int
s (Ref _ u :: Unique
u) = Int -> Unique -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Unique
u
equalRef :: Ref a -> Ref b -> Bool
equalRef :: Ref a -> Ref b -> Bool
equalRef (Ref _ a :: Unique
a) (Ref _ b :: Unique
b) = Unique
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
b
newRef :: MonadIO m => a -> m (Ref a)
newRef :: a -> m (Ref a)
newRef a :: a
a = IO (Ref a) -> m (Ref 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
$ (IORef a -> Unique -> Ref a)
-> IO (IORef a) -> IO Unique -> IO (Ref a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 IORef a -> Unique -> Ref a
forall a. IORef a -> Unique -> Ref a
Ref (a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a) IO Unique
newUnique
readRef :: MonadIO m => Ref a -> m a
readRef :: Ref a -> m a
readRef ~(Ref ref :: IORef a
ref _) = 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
ref
put :: MonadIO m => Ref a -> a -> m ()
put :: Ref a -> a -> m ()
put ~(Ref ref :: IORef a
ref _) = IO () -> m ()
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
ref
modify' :: MonadIO m => Ref a -> (a -> a) -> m ()
modify' :: Ref a -> (a -> a) -> m ()
modify' ~(Ref ref :: IORef a
ref _) f :: a -> a
f = IO () -> m ()
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
ref IO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x :: a
x -> IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x
mkWeakIORefValueFinalizer :: IORef a -> value -> IO () -> IO (Weak value)
#if MIN_VERSION_base(4,9,0)
mkWeakIORefValueFinalizer :: IORef a -> value -> IO () -> IO (Weak value)
mkWeakIORefValueFinalizer r :: IORef a
r@(GHC.IORef (GHC.STRef r# :: MutVar# RealWorld a
r#)) v :: value
v (GHC.IO f :: State# RealWorld -> (# State# RealWorld, () #)
f) = (State# RealWorld -> (# State# RealWorld, Weak value #))
-> IO (Weak value)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
GHC.IO ((State# RealWorld -> (# State# RealWorld, Weak value #))
-> IO (Weak value))
-> (State# RealWorld -> (# State# RealWorld, Weak value #))
-> IO (Weak value)
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case MutVar# RealWorld a
-> value
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, Weak# value #)
forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
GHC.mkWeak# MutVar# RealWorld a
r# value
v State# RealWorld -> (# State# RealWorld, () #)
f State# RealWorld
s of (# s1 :: State# RealWorld
s1, w :: Weak# value
w #) -> (# State# RealWorld
s1, Weak# value -> Weak value
forall v. Weak# v -> Weak v
GHC.Weak Weak# value
w #)
#else
mkWeakIORefValueFinalizer r@(GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s ->
case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #)
#endif
mkWeakIORefValue :: IORef a -> value -> IO (Weak value)
mkWeakIORefValue :: IORef a -> value -> IO (Weak value)
mkWeakIORefValue a :: IORef a
a b :: value
b = IORef a -> value -> IO () -> IO (Weak value)
forall a value. IORef a -> value -> IO () -> IO (Weak value)
mkWeakIORefValueFinalizer IORef a
a value
b (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
mkWeakRefValue :: MonadIO m => Ref a -> value -> m (Weak value)
mkWeakRefValue :: Ref a -> value -> m (Weak value)
mkWeakRefValue (Ref ref :: IORef a
ref _) v :: value
v = IO (Weak value) -> m (Weak value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak value) -> m (Weak value))
-> IO (Weak value) -> m (Weak value)
forall a b. (a -> b) -> a -> b
$ IORef a -> value -> IO (Weak value)
forall a value. IORef a -> value -> IO (Weak value)
mkWeakIORefValue IORef a
ref value
v
deRefWeaks :: [Weak v] -> IO [v]
deRefWeaks :: [Weak v] -> IO [v]
deRefWeaks ws :: [Weak v]
ws = {-# SCC deRefWeaks #-} ([Maybe v] -> [v]) -> IO [Maybe v] -> IO [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe v] -> [v]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe v] -> IO [v]) -> IO [Maybe v] -> IO [v]
forall a b. (a -> b) -> a -> 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)
mapM Weak v -> IO (Maybe v)
forall v. Weak v -> IO (Maybe v)
deRefWeak [Weak v]
ws