module FRP.Sodium.Plain where
import qualified FRP.Sodium.Context as R
import Control.Applicative
import Control.Concurrent.Chan
import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, newMVar, readMVar)
import qualified Control.Concurrent.MVar as MV
import Control.Exception (evaluate)
import Control.Monad
import Control.Monad.State.Strict
import Control.Monad.Trans
import Data.Int
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
import GHC.Exts
import System.Mem.Weak
import System.IO.Unsafe
modifyMVar :: MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar mv f = MV.modifyMVar mv $ \a -> do
(a', b') <- f a
evaluate a'
return (a', b')
modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
modifyMVar_ mv f = MV.modifyMVar_ mv $ \a -> do
a' <- f a
evaluate a'
return a'
putMVar :: MVar a -> a -> IO ()
putMVar mv a = do
evaluate a
MV.putMVar mv a
data Plain
partition :: Partition
partition = unsafePerformIO createPartition
where
createPartition :: IO Partition
createPartition = do
lock <- newEmptyMVar
nextNodeIDRef <- newIORef (NodeID 0)
return $ Partition {
paLock = lock,
paNextNodeID = nextNodeIDRef
}
type Reactive a = R.Reactive Plain a
type Event a = R.Event Plain a
type Behavior a = R.Behavior Plain a
type Behaviour a = R.Behavior Plain a
data Sample a = Sample { unSample_ :: IO (IO a) }
unSample :: Sample a -> IO a
unSample sample = do
sample' <- unSample_ sample
touch sample
sample'
instance R.Context Plain where
newtype Reactive Plain a = Reactive (StateT ReactiveState IO a)
data Event Plain a = Event {
getListenRaw :: Reactive (Listen a),
evCacheRef :: IORef (Maybe (Listen a))
}
data Behavior Plain a = Behavior {
underlyingEvent :: Event a,
behSample :: Sample a
}
sync = sync
ioReactive = ioReactive
newEvent = newEvent
listen = listen
never = never
merge = merge
filterJust = filterJust
hold = hold
changes = changes
values = values
snapshotWith = snapshotWith
switchE = switchE
switch = switch
execute = execute
sample = sample
coalesce = coalesce
once = once
sync :: Reactive a -> IO a
sync task = do
let loop :: StateT ReactiveState IO () = do
queue1 <- gets asQueue1
if not $ Seq.null queue1 then do
let Reactive task = Seq.index queue1 0
modify $ \as -> as { asQueue1 = Seq.drop 1 queue1 }
task
loop
else do
queue2 <- gets asQueue2
mTask <- lift $ popPriorityQueue queue2
case mTask of
Just (Reactive task) -> do
task
loop
Nothing -> do
final <- gets asFinal
if not $ Seq.null final then do
let Reactive task = Seq.index final 0
modify $ \as -> as { asFinal = Seq.drop 1 final }
task
loop
else
return ()
outVar <- newIORef undefined
let lock = paLock partition
putMVar lock ()
q <- newPriorityQueue
evalStateT loop $ ReactiveState {
asQueue1 = Seq.singleton (task >>= ioReactive . writeIORef outVar),
asQueue2 = q,
asFinal = Seq.empty
}
takeMVar lock
readIORef outVar
newEvent :: Reactive (Event a, a -> Reactive ())
newEvent = do
(ev, push, _) <- ioReactive newEventLinked
return (ev, push)
listen :: Event a -> (a -> IO ()) -> Reactive (IO ())
listen ev handle = listenTrans ev (ioReactive . handle)
never :: Event a
never = Event {
getListenRaw = return $ Listen $ \_ _ _ -> return (return ()),
evCacheRef = unsafePerformIO $ newIORef Nothing
}
merge :: Event a -> Event a -> Event a
merge ea eb = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
l1 <- getListen ea
l2 <- getListen eb
(l, push, nodeRef) <- ioReactive newEventImpl
unlistener <- unlistenize $ do
u1 <- runListen l1 (Just nodeRef) False push
u2 <- runListen l2 (Just nodeRef) False push
return (u1 >> u2)
addCleanup_Listen unlistener l
filterJust :: Event (Maybe a) -> Event a
filterJust ema = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
(l', push, nodeRef) <- ioReactive newEventImpl
l <- getListen ema
unlistener <- unlistenize $ runListen l (Just nodeRef) False $ \ma -> case ma of
Just a -> push a
Nothing -> return ()
addCleanup_Listen unlistener l'
hold :: a -> Event a -> Reactive (Behavior a)
hold initA ea = do
bsRef <- ioReactive $ newIORef $ initA `seq` BehaviorState initA Nothing
unlistener <- unlistenize $ linkedListen ea Nothing False $ \a -> do
bs <- ioReactive $ readIORef bsRef
ioReactive $ writeIORef bsRef $ a `seq` bs { bsUpdate = Just a }
when (isNothing (bsUpdate bs)) $ scheduleLast $ ioReactive $ do
bs <- readIORef bsRef
let newCurrent = fromJust (bsUpdate bs)
writeIORef bsRef $ newCurrent `seq` BehaviorState newCurrent Nothing
sample <- ioReactive $ addCleanup_Sample unlistener (Sample $ return $ bsCurrent <$> readIORef bsRef)
let beh = sample `seq` Behavior {
underlyingEvent = ea,
behSample = sample
}
return beh
changes :: Behavior a -> Event a
changes = underlyingEvent
values :: Behavior a -> Event a
values = eventify . listenValueRaw
snapshotWith :: (a -> b -> c) -> Event a -> Behavior b -> Event c
snapshotWith f ea bb = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
(l, push, nodeRef) <- ioReactive newEventImpl
sample' <- ioReactive $ unSample_ $ behSample $ bb
_ <- ioReactive $ touch sample'
unlistener <- unlistenize $ do
unlisten <- linkedListen ea (Just nodeRef) False $ \a -> do
b <- ioReactive $ sample'
push (f a b)
return ()
return (unlisten >> touch bb)
addCleanup_Listen unlistener l
switchE :: Behavior (Event a) -> Event a
switchE bea = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
(l, push, nodeRef) <- ioReactive newEventImpl
unlisten2Ref <- ioReactive $ newIORef Nothing
let doUnlisten2 = do
mUnlisten2 <- readIORef unlisten2Ref
fromMaybe (return ()) mUnlisten2
unlistener1 <- unlistenize $ do
initEa <- sample bea
(ioReactive . writeIORef unlisten2Ref) =<< (Just <$> linkedListen initEa (Just nodeRef) False push)
unlisten1 <- linkedListen (changes bea) (Just nodeRef) False $ \ea -> scheduleLast $ do
ioReactive doUnlisten2
(ioReactive . writeIORef unlisten2Ref) =<< (Just <$> linkedListen ea (Just nodeRef) True push)
return $ unlisten1 >> doUnlisten2
addCleanup_Listen unlistener1 l
switch :: Behavior (Behavior a) -> Reactive (Behavior a)
switch bba = do
ba <- sample bba
za <- sample ba
(ev, push, nodeRef) <- ioReactive newEventLinked
unlisten2Ref <- ioReactive $ newIORef Nothing
let doUnlisten2 = do
mUnlisten2 <- readIORef unlisten2Ref
fromMaybe (return ()) mUnlisten2
unlisten1 <- listenValueRaw bba (Just nodeRef) False $ \ba -> do
ioReactive doUnlisten2
(ioReactive . writeIORef unlisten2Ref . Just) =<< listenValueRaw ba (Just nodeRef) False push
hold za (finalizeEvent ev (unlisten1 >> doUnlisten2))
execute :: Event (Reactive a) -> Event a
execute ev = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
(l', push, nodeRef) <- ioReactive newEventImpl
l <- getListen ev
unlistener <- unlistenize $ runListen l (Just nodeRef) False $ \action -> action >>= push
addCleanup_Listen unlistener l'
sample :: Behavior a -> Reactive a
sample b = ioReactive . unSample . behSample $ b
coalesce :: (a -> a -> a) -> Event a -> Event a
coalesce combine e = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
l1 <- getListen e
(l, push, nodeRef) <- ioReactive newEventImpl
outRef <- ioReactive $ newIORef Nothing
unlistener <- unlistenize $ runListen l1 (Just nodeRef) False $ \a -> do
first <- isNothing <$> ioReactive (readIORef outRef)
ioReactive $ modifyIORef outRef $ \ma -> Just $ case ma of
Just a0 -> a0 `combine` a
Nothing -> a
when first $ schedulePrioritized (Just nodeRef) $ do
Just out <- ioReactive $ readIORef outRef
ioReactive $ writeIORef outRef Nothing
push out
addCleanup_Listen unlistener l
once :: Event a -> Event a
once e = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
l1 <- getListen e
(l, push, nodeRef) <- ioReactive newEventImpl
aliveRef <- ioReactive $ newIORef True
unlistener <- unlistenize $ do
rec
unlisten <- runListen l1 (Just nodeRef) False $ \a -> do
alive <- ioReactive $ readIORef aliveRef
when alive $ do
ioReactive $ writeIORef aliveRef False
scheduleLast $ ioReactive unlisten
push a
return unlisten
addCleanup_Listen unlistener l
newBehavior :: a
-> Reactive (Behavior a, a -> Reactive ())
newBehavior = R.newBehavior
newBehaviour :: a
-> Reactive (Behavior a, a -> Reactive ())
newBehaviour = R.newBehaviour
mergeWith :: (a -> a -> a) -> Event a -> Event a -> Event a
mergeWith = R.mergeWith
filterE :: (a -> Bool) -> Event a -> Event a
filterE = R.filterE
snapshot :: Event a -> Behavior b -> Event b
snapshot = R.snapshot
gate :: Event a -> Behavior Bool -> Event a
gate = R.gate
collectE :: (a -> s -> (b, s)) -> s -> Event a -> Reactive (Event b)
collectE = R.collectE
collect :: (a -> s -> (b, s)) -> s -> Behavior a -> Reactive (Behavior b)
collect = R.collect
accumE :: (a -> s -> s) -> s -> Event a -> Reactive (Event s)
accumE = R.accumE
accum :: (a -> s -> s) -> s -> Event a -> Reactive (Behavior s)
accum = R.accum
countE :: Event a -> Reactive (Event Int)
countE = R.countE
count :: Event a -> Reactive (Behavior Int)
count = R.count
class PriorityQueueable k where
priorityOf :: k -> IO Int64
newtype Sequence = Sequence Int64 deriving (Eq, Ord, Enum)
data PriorityQueue k v = PriorityQueue {
pqNextSeq :: IORef Sequence,
pqDirty :: IORef Bool,
pqQueue :: IORef (Map (Int64, Sequence) v),
pqData :: IORef (Map Sequence (k, v))
}
newPriorityQueue :: IO (PriorityQueue k v)
newPriorityQueue =
PriorityQueue <$> newIORef (Sequence 0) <*> newIORef False
<*> newIORef M.empty <*> newIORef M.empty
pushPriorityQueue :: PriorityQueueable k => PriorityQueue k v -> k -> v -> IO ()
pushPriorityQueue pq k v = do
prio <- priorityOf k
seq <- readIORef (pqNextSeq pq)
modifyIORef (pqNextSeq pq) succ
modifyIORef (pqQueue pq) (M.insert (prio, seq) v)
modifyIORef (pqData pq) (M.insert seq (k, v))
dirtyPriorityQueue :: PriorityQueue k v -> IO ()
dirtyPriorityQueue pq = writeIORef (pqDirty pq) True
popPriorityQueue :: PriorityQueueable k => PriorityQueue k v -> IO (Maybe v)
popPriorityQueue pq = do
maybeRegen
q <- readIORef (pqQueue pq)
if M.null q
then return Nothing
else do
let (pseq@(prio, seq), v) = M.findMin q
modifyIORef (pqQueue pq) (M.delete pseq)
modifyIORef (pqData pq) (M.delete seq)
return $ Just v
where
maybeRegen = do
dirty <- readIORef (pqDirty pq)
when dirty $ do
writeIORef (pqDirty pq) False
dat <- readIORef (pqData pq)
writeIORef (pqQueue pq) M.empty
forM_ (M.assocs dat) $ \(seq,(k,v)) -> do
prio <- priorityOf k
modifyIORef (pqQueue pq) (M.insert (prio, seq) v)
type ID = Int64
instance PriorityQueueable (Maybe (MVar Node)) where
priorityOf (Just nodeRef) = noRank <$> readMVar nodeRef
priorityOf Nothing = return maxBound
data ReactiveState = ReactiveState {
asQueue1 :: Seq (Reactive ()),
asQueue2 :: PriorityQueue (Maybe (MVar Node)) (Reactive ()),
asFinal :: Seq (Reactive ())
}
instance Functor (R.Reactive Plain) where
fmap f rm = Reactive (fmap f (unReactive rm))
unReactive :: Reactive a -> StateT ReactiveState IO a
unReactive (Reactive m) = m
instance Applicative (R.Reactive Plain) where
pure a = Reactive $ return a
rf <*> rm = Reactive $ unReactive rf <*> unReactive rm
instance Monad (R.Reactive Plain) where
return a = Reactive $ return a
rma >>= kmb = Reactive $ do
a <- unReactive rma
unReactive (kmb a)
instance MonadFix (R.Reactive Plain) where
mfix f = Reactive $ mfix $ \a -> unReactive (f a)
ioReactive :: IO a -> Reactive a
ioReactive io = Reactive $ liftIO io
newtype NodeID = NodeID Int deriving (Eq, Ord, Enum)
data Partition = Partition {
paLock :: MVar (),
paNextNodeID :: IORef NodeID
}
scheduleEarly :: Reactive () -> Reactive ()
scheduleEarly task = Reactive $ modify $ \as -> as { asQueue1 = asQueue1 as |> task }
scheduleLast :: Reactive () -> Reactive ()
scheduleLast task = Reactive $ modify $ \as -> as { asFinal = asFinal as |> task }
data Listen a = Listen { runListen_ :: Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ()) }
runListen :: Listen a -> Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())
runListen l mv suppressEarlierFirings handle = do
unlisten <- runListen_ l mv suppressEarlierFirings handle
_ <- ioReactive $ touch l
return unlisten
getListen :: Event a -> Reactive (Listen a)
getListen (Event getLRaw cacheRef) = do
mL <- ioReactive $ readIORef cacheRef
case mL of
Just l -> return l
Nothing -> do
l <- getLRaw
ioReactive $ writeIORef cacheRef (Just l)
return l
linkedListen :: Event a -> Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())
linkedListen ev mMvTarget suppressEarlierFirings handle = do
l <- getListen ev
runListen l mMvTarget suppressEarlierFirings handle
listenTrans :: Event a -> (a -> Reactive ()) -> Reactive (IO ())
listenTrans ev handle = linkedListen ev Nothing False handle
data Observer p a = Observer {
obNextID :: ID,
obListeners :: Map ID (a -> Reactive ()),
obFirings :: [a]
}
data Node = Node {
noID :: NodeID,
noRank :: Int64,
noListeners :: Map ID (MVar Node)
}
newNode :: IO (MVar Node)
newNode = do
nodeID <- readIORef (paNextNodeID partition)
modifyIORef (paNextNodeID partition) succ
newMVar (Node nodeID 0 M.empty)
wrap :: (Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())) -> IO (Listen a)
wrap l = return (Listen l)
touch :: a -> IO ()
touch a = evaluate a >> return ()
linkNode :: MVar Node -> ID -> MVar Node -> IO Bool
linkNode nodeRef iD mvTarget = do
no <- readMVar nodeRef
modified <- ensureBiggerThan S.empty mvTarget (noRank no)
modifyMVar_ nodeRef $ \no -> return $
let listeners' = M.insert iD mvTarget (noListeners no)
in listeners' `seq` no { noListeners = listeners' }
return modified
ensureBiggerThan :: Set NodeID -> MVar Node -> Int64 -> IO Bool
ensureBiggerThan visited nodeRef limit = do
no <- takeMVar nodeRef
if noRank no > limit || noID no `S.member` visited then do
putMVar nodeRef no
return False
else do
let newSerial = succ limit
putMVar nodeRef $ newSerial `seq` no { noRank = newSerial }
forM_ (M.elems . noListeners $ no) $ \mvTarget -> do
ensureBiggerThan (S.insert (noID no) visited) mvTarget newSerial
return True
unlinkNode :: MVar Node -> ID -> IO ()
unlinkNode nodeRef iD = do
modifyMVar_ nodeRef $ \no -> do
let listeners' = M.delete iD (noListeners no)
return $ listeners' `seq` no { noListeners = listeners' }
newEventImpl :: forall p a . IO (Listen a, a -> Reactive (), MVar Node)
newEventImpl = do
nodeRef <- newNode
mvObs <- newMVar (Observer 0 M.empty [])
cacheRef <- newIORef Nothing
rec
let l mMvTarget suppressEarlierFirings handle = do
(firings, unlisten, iD) <- ioReactive $ modifyMVar mvObs $ \ob -> do
let iD = obNextID ob
nextID' = succ iD
listeners' = M.insert iD handle (obListeners ob)
ob' = nextID' `seq` listeners' `seq`
ob { obNextID = nextID',
obListeners = listeners' }
unlisten = do
modifyMVar_ mvObs $ \ob -> do
let listeners' = M.delete iD (obListeners ob)
return $ listeners' `seq` ob { obListeners = listeners' }
unlinkNode nodeRef iD
touch listen
return ()
return (ob', (reverse . obFirings $ ob, unlisten, iD))
modified <- case mMvTarget of
Just mvTarget -> ioReactive $ linkNode nodeRef iD mvTarget
Nothing -> return False
when modified $ dirtyPrioritized
unless suppressEarlierFirings $ mapM_ handle firings
return unlisten
listen <- wrap l
let push a = do
ioReactive $ evaluate a
ob <- ioReactive $ modifyMVar mvObs $ \ob -> return $
(ob { obFirings = a : obFirings ob }, ob)
when (null (obFirings ob)) $ scheduleLast $ ioReactive $ do
modifyMVar_ mvObs $ \ob -> return $ ob { obFirings = [] }
mapM_ ($ a) (M.elems . obListeners $ ob)
return (listen, push, nodeRef)
newEventLinked :: IO (Event a, a -> Reactive (), MVar Node)
newEventLinked = do
(listen, push, nodeRef) <- newEventImpl
cacheRef <- newIORef Nothing
let ev = Event {
getListenRaw = return listen,
evCacheRef = cacheRef
}
return (ev, push, nodeRef)
instance Functor (R.Event Plain) where
f `fmap` e = Event getListen' cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
getListen' = do
return $ Listen $ \mNodeRef suppressEarlierFirings handle -> do
l <- getListen e
runListen l mNodeRef suppressEarlierFirings (handle . f)
instance Functor (R.Behavior Plain) where
f `fmap` Behavior underlyingEvent sample =
sample' `seq` Behavior (f `fmap` underlyingEvent) sample'
where sample' = Sample $ return $ f `fmap` unSample sample
constant :: a -> Behavior a
constant a = Behavior {
underlyingEvent = never,
behSample = Sample $ return $ return a
}
data BehaviorState a = BehaviorState {
bsCurrent :: a,
bsUpdate :: Maybe a
}
finalizeEvent :: Event a -> IO () -> Event a
finalizeEvent ea unlisten = Event gl (evCacheRef ea)
where
gl = do
l <- getListen ea
ioReactive $ finalizeListen l unlisten
finalizeListen :: Listen a -> IO () -> IO (Listen a)
finalizeListen l unlisten = do
addFinalizer l unlisten
return l
finalizeSample :: Sample a -> IO () -> IO (Sample a)
finalizeSample s unlisten = do
addFinalizer s unlisten
return s
newtype Unlistener = Unlistener (MVar (Maybe (IO ())))
unlistenize :: Reactive (IO ()) -> Reactive Unlistener
unlistenize doListen = do
unlistener@(Unlistener ref) <- newUnlistener
scheduleEarly $ do
mOldUnlisten <- ioReactive $ takeMVar ref
case mOldUnlisten of
Just _ -> do
unlisten <- doListen
ioReactive $ putMVar ref (Just unlisten)
Nothing -> ioReactive $ putMVar ref mOldUnlisten
return unlistener
where
newUnlistener :: Reactive Unlistener
newUnlistener = Unlistener <$> ioReactive (newMVar (Just $ return ()))
addCleanup_Listen :: Unlistener -> Listen a -> Reactive (Listen a)
addCleanup_Listen (Unlistener ref) l = ioReactive $ finalizeListen l $ do
mUnlisten <- takeMVar ref
fromMaybe (return ()) mUnlisten
putMVar ref Nothing
addCleanup_Sample :: Unlistener -> Sample a -> IO (Sample a)
addCleanup_Sample (Unlistener ref) r = finalizeSample r $ do
mUnlisten <- takeMVar ref
fromMaybe (return ()) mUnlisten
putMVar ref Nothing
listenValueRaw :: Behavior a -> Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())
listenValueRaw ba = lastFiringOnly $ \mNodeRef suppressEarlierFirings handle -> do
a <- sample ba
handle a
linkedListen (underlyingEvent ba) mNodeRef suppressEarlierFirings handle
schedulePrioritized :: Maybe (MVar Node)
-> Reactive ()
-> Reactive ()
schedulePrioritized mNodeRef task = Reactive $ do
q <- gets asQueue2
lift $ pushPriorityQueue q mNodeRef task
dirtyPrioritized :: Reactive ()
dirtyPrioritized = Reactive $ do
q <- gets asQueue2
lift $ dirtyPriorityQueue q
lastFiringOnly :: (Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ()))
-> Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())
lastFiringOnly listen mNodeRef suppressEarlierFirings handle = do
aRef <- ioReactive $ newIORef Nothing
listen mNodeRef suppressEarlierFirings $ \a -> do
ma <- ioReactive $ readIORef aRef
ioReactive $ writeIORef aRef (Just a)
when (isNothing ma) $ schedulePrioritized mNodeRef $ do
Just a <- ioReactive $ readIORef aRef
ioReactive $ writeIORef aRef Nothing
handle a
listenValueTrans :: Behavior a -> (a -> Reactive ()) -> Reactive (IO ())
listenValueTrans ba = listenValueRaw ba Nothing False
eventify :: (Maybe (MVar Node) -> Bool -> (a -> Reactive ()) -> Reactive (IO ())) -> Event a
eventify listen = Event gl cacheRef
where
cacheRef = unsafePerformIO $ newIORef Nothing
gl = do
(l, push, nodeRef) <- ioReactive newEventImpl
unlistener <- unlistenize $ listen (Just nodeRef) False push
addCleanup_Listen unlistener l
instance Applicative (R.Behavior Plain) where
pure = constant
Behavior u1 s1 <*> Behavior u2 s2 = Behavior u s
where
cacheRef = unsafePerformIO $ newIORef Nothing
u = Event gl cacheRef
gl = do
fRef <- ioReactive $ newIORef =<< unSample s1
aRef <- ioReactive $ newIORef =<< unSample s2
l1 <- getListen u1
l2 <- getListen u2
(l, push, nodeRef) <- ioReactive newEventImpl
unlistener <- unlistenize $ do
un1 <- runListen l1 (Just nodeRef) False $ \f -> do
ioReactive $ writeIORef fRef f
a <- ioReactive $ readIORef aRef
push (f a)
un2 <- runListen l2 (Just nodeRef) False $ \a -> do
f <- ioReactive $ readIORef fRef
ioReactive $ writeIORef aRef a
push (f a)
return (un1 >> un2)
addCleanup_Listen unlistener l
s = Sample $ return $ ($) <$> unSample s1 <*> unSample s2