on develop help sign in
Reorganize the event reading stuff
commit24330d8013afaad0becabf947ef0f0e738d8f601 authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 4 Aug 2016, 15:23 (10 years ago) parentf2205a1
1 file changed+82−50
src/Reflex/Spider/Internal.hs+82−50
src/Reflex/Spider/Internal.hs+82−50
@@ -39,7 +39,6 @@ import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence)
3939import Control.Monad.Primitive
4040import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence)
4141import Control.Monad.Ref
42−import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence)
4342import Data.Align
4443import Data.Coerce
4544import Data.Dependent.Map (DMap, DSum (..))
@@ -54,15 +53,12 @@ import Data.IntMap.Strict (IntMap)
5453import qualified Data.IntMap.Strict as IntMap
5554import Data.IORef
5655import Data.List hiding (foldl')
57−import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
58−import qualified Data.List.NonEmpty as NonEmpty
5956import Data.Maybe
60−import Data.Monoid (mempty, (<>))
57+import Data.Monoid ((<>))
6158import Data.Some (Some)
6259import qualified Data.Some as Some
6360import Data.These
6461import Data.Traversable
65−import Data.Tree (Forest, Tree (..), drawForest)
6662import Data.Word
6763import GHC.IORef (IORef (..))
6864import GHC.Stack
@@ -70,6 +66,14 @@ import System.IO.Unsafe
7066import System.Mem.Weak
7167import Unsafe.Coerce
7268
69+#ifdef DEBUG_CYCLES
70+import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence)
71+import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
72+import qualified Data.List.NonEmpty as NonEmpty
73+import Data.Monoid (mempty)
74+import Data.Tree (Forest, Tree (..), drawForest)
75+#endif
76+
7377import Data.WeakBag (WeakBag, WeakBagTicket)
7478import qualified Data.WeakBag as WeakBag
7579import qualified Reflex.Class as R
@@ -188,6 +192,12 @@ unsafeNodeId a = unsafePerformIO $ do
188192
189193newtype Event x a = Event { subscribe :: Subscriber x a -> EventM x (EventSubscription x a) }
190194
195+subscribeAndRead :: Event x a -> Subscriber x a -> EventM x (EventSubscription x a, Maybe a)
196+subscribeAndRead e sub = do
197+ subscription@(EventSubscription _ subd) <- subscribe e sub
198+ occ <- liftIO $ eventSubscribedRead subd
199+ return (subscription, occ)
200+
191201wrap :: Monad m => (t -> EventSubscribed x a) -> (Subscriber x a -> m (WeakBagTicket (Subscriber x a), t)) -> Subscriber x a -> m (EventSubscription x a)
192202wrap tag getSpecificSubscribed sub = do
193203 (sln, subd) <- getSpecificSubscribed sub
@@ -230,8 +240,7 @@ eventDynIdentity !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent
230240subscribeCoincidenceInner :: CanSubscribe x m => Event x a -> Height -> CoincidenceSubscribed x a -> m (Maybe a, Height, EventSubscribed x a)
231241subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do
232242 subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe
233− subscription@(EventSubscription _ innerSubd) <- subscribe inner subInner
234− innerOcc <- liftIO $ readEventSubscribed innerSubd
243+ (subscription@(EventSubscription _ innerSubd), innerOcc) <- subscribeAndRead inner subInner
235244 innerHeight <- liftIO $ getEventSubscribedHeight innerSubd
236245 let height = max innerHeight outerHeight
237246 defer $ SomeResetCoincidence subscription $ if height > outerHeight then Just subscribedUnsafe else Nothing
@@ -298,13 +307,19 @@ newSubscriberMerge k subscribed = return $ Subscriber
298307 --TODO: assertions about height
299308 currentHeight <- getCurrentHeight
300309 when (height <= currentHeight) $ do
301− myStack <- liftIO $ whoCreatedIORef $ mergeSubscribedCachedSubscribed subscribed
302310 if height /= invalidHeight
303− then error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")\n" ++ unlines (reverse myStack)
311+ then do
312+ myStack <- liftIO $ whoCreatedIORef $ mergeSubscribedCachedSubscribed subscribed
313+ error $ "Height (" ++ show height ++ ") is not greater than current height (" ++ show currentHeight ++ ")\n" ++ unlines (reverse myStack)
304314 else liftIO $ do
315+#ifdef DEBUG_CYCLES
305316 nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed
306317 stacks <- forM nodesInvolvedInCycle $ \(Some.This es) -> whoCreatedEventSubscribed es
307− error $ "Causality loop found:\n" <> drawForest (listsToForest stacks)
318+ let cycleInfo = ":\n" <> drawForest (listsToForest stacks)
319+#else
320+ let cycleInfo = ""
321+#endif
322+ error $ "Causality loop found" <> cycleInfo
308323 scheduleMerge height subscribed
309324 , subscriberInvalidateHeight = \old -> do
310325 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed
@@ -441,10 +456,12 @@ propagate a subscribers = withIncreasedDepth $ do
441456data EventSubscribed x a = EventSubscribed
442457 { eventSubscribedSubscribe :: !(Subscriber x a -> IO (Maybe (WeakBagTicket (Subscriber x a))))
443458 , eventSubscribedRead :: !(IO (Maybe a))
444− , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops
445459 , eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
460+#ifdef DEBUG_CYCLES
461+ , eventSubscribedGetParents :: !(IO [Some (EventSubscribed x)]) -- For debugging loops
446462 , eventSubscribedHasOwnHeightRef :: !Bool
447463 , eventSubscribedWhoCreated :: !(IO [String])
464+#endif
448465 }
449466
450467readEventSubscribed :: EventSubscribed x a -> IO (Maybe a)
@@ -457,83 +474,98 @@ eventSubscribedRoot :: RootSubscribed x a -> EventSubscribed x a
457474eventSubscribedRoot !r = EventSubscribed
458475 { eventSubscribedSubscribe = \sub -> Just <$> subscribeRootSubscribed r sub
459476 , eventSubscribedRead = readRootSubscribed r
460− , eventSubscribedGetParents = return []
461477 , eventSubscribedHeightRef = zeroRef
478+#ifdef DEBUG_CYCLES
479+ , eventSubscribedGetParents = return []
462480 , eventSubscribedHasOwnHeightRef = False
463481 , eventSubscribedWhoCreated = return ["root"]
482+#endif
464483 }
465484
466485eventSubscribedNever :: EventSubscribed x a
467486eventSubscribedNever = EventSubscribed
468487 { eventSubscribedSubscribe = \_ -> return Nothing
469488 , eventSubscribedRead = return Nothing
470− , eventSubscribedGetParents = return []
471489 , eventSubscribedHeightRef = zeroRef
490+#ifdef DEBUG_CYCLES
491+ , eventSubscribedGetParents = return []
472492 , eventSubscribedHasOwnHeightRef = False
473493 , eventSubscribedWhoCreated = return ["never"]
494+#endif
474495 }
475496
476497eventSubscribedPush :: PushSubscribed x b a -> EventSubscribed x a
477498eventSubscribedPush !subscribed = EventSubscribed
478499 { eventSubscribedSubscribe = \sub -> Just <$> subscribePushSubscribed subscribed sub
479500 , eventSubscribedRead = readPushSubscribed subscribed
480− , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ pushSubscribedParent subscribed]
481501 , eventSubscribedHeightRef = pushSubscribedHeight subscribed
502+#ifdef DEBUG_CYCLES
503+ , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ pushSubscribedParent subscribed]
482504 , eventSubscribedHasOwnHeightRef = False
483505 , eventSubscribedWhoCreated = whoCreatedIORef $ pushSubscribedCachedSubscribed subscribed
506+#endif
484507 }
485508
486509eventSubscribedMerge :: a ~ DMap k Identity => MergeSubscribed x k -> EventSubscribed x a
487510eventSubscribedMerge !subscribed = EventSubscribed
488511 { eventSubscribedSubscribe = \sub -> Just <$> subscribeMergeSubscribed subscribed sub
489512 , eventSubscribedRead = readMergeSubscribed subscribed
513+ , eventSubscribedHeightRef = mergeSubscribedHeight subscribed
514+#ifdef DEBUG_CYCLES
490515 , eventSubscribedGetParents = do
491516 ps <- readIORef $ mergeSubscribedParents subscribed
492517 return $ R.ffor (DMap.toList ps) $ \(_ :=> v) -> Some.This $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription v
493− , eventSubscribedHeightRef = mergeSubscribedHeight subscribed
494518 , eventSubscribedHasOwnHeightRef = True
495519 , eventSubscribedWhoCreated = whoCreatedIORef $ mergeSubscribedCachedSubscribed subscribed
520+#endif
496521 }
497522
498523eventSubscribedFan :: GCompare k => k a -> FanSubscribed x k -> EventSubscribed x a
499524eventSubscribedFan !k !subscribed = EventSubscribed
500525 { eventSubscribedSubscribe = \sub -> Just <$> subscribeFanSubscribed k subscribed sub
501526 , eventSubscribedRead = readFanSubscribed k subscribed
502− , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
503527 , eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
528+#ifdef DEBUG_CYCLES
529+ , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
504530 , eventSubscribedHasOwnHeightRef = False
505531 , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed
532+#endif
506533 }
507534
508535eventSubscribedSwitch :: SwitchSubscribed x a -> EventSubscribed x a
509536eventSubscribedSwitch !subscribed = EventSubscribed
510537 { eventSubscribedSubscribe = \sub -> Just <$> subscribeSwitchSubscribed subscribed sub
511538 , eventSubscribedRead = readSwitchSubscribed subscribed
539+ , eventSubscribedHeightRef = switchSubscribedHeight subscribed
540+#ifdef DEBUG_CYCLES
512541 , eventSubscribedGetParents = do
513542 s <- readIORef $ switchSubscribedCurrentParent subscribed
514543 return [Some.This $ _eventSubscription_subscribed s]
515− , eventSubscribedHeightRef = switchSubscribedHeight subscribed
516544 , eventSubscribedHasOwnHeightRef = True
517545 , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed
546+#endif
518547 }
519548
520549eventSubscribedCoincidence :: CoincidenceSubscribed x a -> EventSubscribed x a
521550eventSubscribedCoincidence !subscribed = EventSubscribed
522551 { eventSubscribedSubscribe = \sub -> Just <$> subscribeCoincidenceSubscribed subscribed sub
523552 , eventSubscribedRead = readCoincidenceSubscribed subscribed
553+ , eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed
554+#ifdef DEBUG_CYCLES
524555 , eventSubscribedGetParents = do
525556 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
526557 let outerParent = Some.This $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
527558 innerParents = maybeToList $ fmap Some.This innerSubscription
528559 return $ outerParent : innerParents
529− , eventSubscribedHeightRef = coincidenceSubscribedHeight subscribed
530560 , eventSubscribedHasOwnHeightRef = True
531561 , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed
562+#endif
532563 }
533564
534565getEventSubscribedHeight :: EventSubscribed x a -> IO Height
535566getEventSubscribedHeight es = readIORef $ eventSubscribedHeightRef es
536567
568+#ifdef DEBUG_CYCLES
537569whoCreatedEventSubscribed :: EventSubscribed x a -> IO [String]
538570whoCreatedEventSubscribed = eventSubscribedWhoCreated
539571
@@ -547,6 +579,7 @@ walkInvalidHeightParents s0 = do
547579 mapM_ loop =<< liftIO (eventSubscribedGetParents s)
548580 forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
549581 return subscribers
582+#endif
550583
551584{-# INLINE subscribeHoldEvent #-}
552585subscribeHoldEvent :: (CanSubscribe x m, R.Patch p) => Hold x p a -> Subscriber x (p a) -> m (EventSubscription x (p a))
@@ -711,8 +744,7 @@ getHoldEventSubscription h = do
711744 Right subd -> return subd
712745 Left e -> do
713746 subscriptionRef <- liftIO $ newIORef $ error "getHoldEventSubscription: subdRef uninitialized"
714− subscription@(EventSubscription _ subd) <- subscribe e =<< liftIO (newSubscriberHold h)
715− occ <- liftIO $ readEventSubscribed subd
747+ (subscription@(EventSubscription _ _), occ) <- subscribeAndRead e =<< liftIO (newSubscriberHold h)
716748 liftIO $ writeIORef subscriptionRef $! subscription
717749 case occ of
718750 Nothing -> return ()
@@ -1215,6 +1247,7 @@ traceMWhen b getMessage = when b $ do
12151247whoCreatedIORef :: IORef a -> IO [String]
12161248whoCreatedIORef (IORef a) = whoCreated $! a
12171249
1250+#ifdef DEBUG_CYCLES
12181251groupByHead :: Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
12191252groupByHead = \case
12201253 [] -> []
@@ -1226,6 +1259,7 @@ groupByHead = \case
12261259
12271260listsToForest :: Eq a => [[a]] -> Forest a
12281261listsToForest l = fmap (\(a, l') -> Node a $ listsToForest $ toList l') $ groupByHead $ catMaybes $ fmap nonEmpty l
1262+#endif
12291263
12301264{-# INLINE propagateSubscriberHold #-}
12311265propagateSubscriberHold :: R.Patch p => Hold x p a -> p a -> EventM x ()
@@ -1428,8 +1462,7 @@ getPushSubscribed p sub = do
14281462 subscribedRef <- liftIO $ newIORef $ error "getPushSubscribed: subscribed not yet intialized"
14291463 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
14301464 s <- liftIO $ newSubscriberPush (pushCompute p) subscribedUnsafe
1431− subscription@(EventSubscription _ subd) <- subscribe (pushParent p) s
1432− parentOcc <- liftIO $ readEventSubscribed subd
1465+ (subscription@(EventSubscription _ subd), parentOcc) <- subscribeAndRead (pushParent p) s
14331466 occ <- runComputeM $ join <$> mapM (pushCompute p) parentOcc
14341467 occRef <- liftIO $ newIORef occ
14351468 when (isJust occ) $ scheduleClear occRef
@@ -1476,8 +1509,7 @@ getMergeSubscribed m sub = do
14761509 initialParents <- readBehaviorUntracked $ current $ mergeParents m
14771510 subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent x k))] <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
14781511 s <- liftIO $ newSubscriberMerge k subscribedUnsafe
1479− subscription@(EventSubscription _ parentSubd) <- subscribe e s
1480− parentOcc <- liftIO $ readEventSubscribed parentSubd
1512+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
14811513 height <- liftIO $ getEventSubscribedHeight parentSubd
14821514 return $ (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription s)
14831515 let dm = DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
@@ -1605,12 +1637,11 @@ getSwitchSubscribed s sub = do
16051637 parentsRef <- liftIO $ newIORef [] --TODO: This should be unnecessary, because it will always be filled with just the single parent behavior
16061638 holdInits <- getDeferralQueue
16071639 e <- liftIO $ runBehaviorM (readBehaviorTracked (switchParent s)) (Just (wi, parentsRef)) holdInits
1608− subscription@(EventSubscription _ subd) <- subscribe e mySub
1609− parentOcc <- liftIO $ readEventSubscribed subd
1640+ (subscription@(EventSubscription _ subd), parentOcc) <- subscribeAndRead e mySub
1641+ heightRef <- liftIO $ newIORef =<< getEventSubscribedHeight subd
16101642 subscriptionRef <- liftIO $ newIORef subscription
16111643 occRef <- liftIO $ newIORef parentOcc
16121644 when (isJust parentOcc) $ scheduleClear occRef
1613− heightRef <- liftIO $ newIORef =<< getEventSubscribedHeight subd
16141645 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
16151646 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
16161647 let !subscribed = SwitchSubscribed
@@ -1655,8 +1686,7 @@ getCoincidenceSubscribed c sub = do
16551686 subscribedRef <- liftIO $ newIORef $ error "getCoincidenceSubscribed: subscribed has not yet been created"
16561687 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
16571688 subOuter <- liftIO $ newSubscriberCoincidenceOuter subscribedUnsafe
1658− outerSubscription@(EventSubscription _ outerSubd) <- subscribe (coincidenceParent c) subOuter
1659− outerOcc <- liftIO $ readEventSubscribed outerSubd
1689+ (outerSubscription@(EventSubscription _ outerSubd), outerOcc) <- subscribeAndRead (coincidenceParent c) subOuter
16601690 outerHeight <- liftIO $ getEventSubscribedHeight outerSubd
16611691 (occ, height, mInnerSubd) <- case outerOcc of
16621692 Nothing -> return (Nothing, outerHeight, Nothing)
@@ -1731,8 +1761,7 @@ initHold (SomeHoldInit h) = void $ getHoldEventSubscription h
17311761initMerge :: SomeMergeInit x -> EventM x ()
17321762initMerge (SomeMergeInit subscribed changed) = do
17331763 changeSub <- liftIO $ newSubscriberMergeChange subscribed
1734− EventSubscription _ changeSubd <- subscribe changed changeSub
1735− change <- liftIO $ readEventSubscribed changeSubd
1764+ (EventSubscription _ changeSubd, change) <- subscribeAndRead changed changeSub
17361765 forM_ change $ \c -> defer $ SomeMergeUpdate c subscribed
17371766 liftIO $ writeIORef (mergeSubscribedChange subscribed) (changeSub, changeSubd)
17381767
@@ -1779,8 +1808,8 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
17791808 Just e -> do
17801809 s <- liftIO $ newSubscriberMerge k m
17811810 subscription@(EventSubscription _ subd) <- subscribe e s
1782− let newParent = MergeSubscribedParent subscription s
17831811 newParentHeight <- liftIO $ getEventSubscribedHeight subd
1812+ let newParent = MergeSubscribedParent subscription s
17841813 liftIO $ addMergeHeight newParentHeight m
17851814 return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
17861815 forM_ mOldSubd $ \oldSubd -> do
@@ -1849,10 +1878,12 @@ zeroHeight = Height 0
18491878invalidHeight :: Height
18501879invalidHeight = Height (-1000)
18511880
1881+#ifdef DEBUG_CYCLES
18521882-- | An invalid height that is currently being traversed, e.g. by walkInvalidHeightParents
18531883{-# INLINE invalidHeightBeingTraversed #-}
18541884invalidHeightBeingTraversed :: Height
18551885invalidHeightBeingTraversed = Height (-1001)
1886+#endif
18561887
18571888{-# INLINE succHeight #-}
18581889succHeight :: Height -> Height
@@ -2104,20 +2135,28 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where
21042135 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . DynamicHold <$> hold v0 e
21052136
21062137data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)
2107−newtype SpiderEventHandle x a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription x a }
21082138
2109−emptySubscriber :: Subscriber x a
2110−emptySubscriber = Subscriber
2111− { subscriberPropagate = \_ -> return ()
2112− , subscriberInvalidateHeight = \_ -> return ()
2113− , subscriberRecalculateHeight = \_ -> return ()
2139+data SpiderEventHandle x a = SpiderEventHandle
2140+ { spiderEventHandleSubscription :: EventSubscription x a
2141+ , spiderEventHandleValue :: IORef (Maybe a)
21142142 }
21152143
21162144instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHostFrame x) where
21172145 {-# INLINABLE subscribeEvent #-}
21182146 subscribeEvent e = SpiderHostFrame $ do
2119− subscription <- subscribe (unSpiderEvent e) emptySubscriber --TODO: Unsubscribe eventually (manually and/or with weak ref)
2120− return $ SpiderEventHandle subscription
2147+ --TODO: Unsubscribe eventually (manually and/or with weak ref)
2148+ val <- liftIO $ newIORef Nothing
2149+ subscription <- subscribe (unSpiderEvent e) $ Subscriber
2150+ { subscriberPropagate = \a -> do
2151+ liftIO $ writeIORef val $ Just a
2152+ scheduleClear val
2153+ , subscriberInvalidateHeight = \_ -> return ()
2154+ , subscriberRecalculateHeight = \_ -> return ()
2155+ }
2156+ return $ SpiderEventHandle
2157+ { spiderEventHandleSubscription = subscription
2158+ , spiderEventHandleValue = val
2159+ }
21212160
21222161instance R.ReflexHost (SpiderEnv x) where
21232162 type EventTrigger (SpiderEnv x) = RootTrigger x
@@ -2127,10 +2166,8 @@ instance R.ReflexHost (SpiderEnv x) where
21272166instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where
21282167 {-# INLINABLE readEvent #-}
21292168 readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do
2130− let EventSubscription sln subscribed = unSpiderEventHandle h
2131− result <- readEventSubscribed subscribed
2132− touch sln
2133− return result
2169+ touch h
2170+ readIORef $ spiderEventHandleValue h
21342171
21352172instance MonadRef (EventM x) where
21362173 type Ref (EventM x) = Ref IO
@@ -2220,12 +2257,7 @@ instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHostFrame x) where
22202257
22212258instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHost x) where
22222259 {-# INLINABLE subscribeEvent #-}
2223− subscribeEvent = subscribeEventSpiderHost
2224−
2225−subscribeEventSpiderHost :: R.Event (SpiderEnv x) a -> SpiderHost x (R.EventHandle (SpiderEnv x) a)
2226−subscribeEventSpiderHost e = do
2227− subscription <- runFrame $ subscribe (unSpiderEvent e) emptySubscriber --TODO: Unsubscribe eventually (manually and/or with weak ref)
2228− return $ SpiderEventHandle subscription
2260+ subscribeEvent = runFrame . runSpiderHostFrame . R.subscribeEvent
22292261
22302262newtype ReadPhase x a = ReadPhase (ResultM x a) deriving (Functor, Applicative, Monad, MonadFix)
22312263