@@ -20,15 +20,7 @@
2020{-# LANGUAGE UndecidableInstances #-}
2121-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses
2222-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.
23−module Reflex.Spider.Internal
24− ( Spider
25− , SpiderEnv (..)
26− , Global
27− , SpiderHost
28− , runSpiderHost
29− , newSpiderEnv
30− , askSpiderEnv
31− ) where
23+module Reflex.Spider.Internal where
3224
3325import Control.Applicative
3426import Control.Concurrent
@@ -374,7 +366,7 @@ data Hold p a
374366 }
375367
376368data EventEnv x
377− = EventEnv { eventEnvSpiderEnv :: !(SpiderEnv x)
369+ = EventEnv { eventEnvSpiderTimeline :: !(SpiderTimeline x)
378370 , eventEnvAssignments :: !(IORef [SomeAssignment]) -- Needed for Subscribe
379371 , eventEnvHoldInits :: !(IORef [SomeHoldInit]) -- Needed for Subscribe
380372 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate])
@@ -433,17 +425,17 @@ instance HasCurrentHeight (EventM x) where
433425 delayedRef <- asks eventEnvDelayedMerges
434426 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [DelayedMerge subscribed]
435427
436−class HasSpiderEnv x m | m -> x where
437− -- | Retrieve the current SpiderEnv
438− askSpiderEnv :: m (SpiderEnv x)
428+class HasSpiderTimeline x m | m -> x where
429+ -- | Retrieve the current SpiderTimeline
430+ askSpiderTimeline :: m (SpiderTimeline x)
439431
440−instance HasSpiderEnv x (EventM x) where
441− {-# INLINE askSpiderEnv #-}
442− askSpiderEnv = EventM $ asks eventEnvSpiderEnv
432+instance HasSpiderTimeline x (EventM x) where
433+ {-# INLINE askSpiderTimeline #-}
434+ askSpiderTimeline = EventM $ asks eventEnvSpiderTimeline
443435
444−instance HasSpiderEnv x (SpiderHost x) where
445− {-# INLINE askSpiderEnv #-}
446− askSpiderEnv = SpiderHost ask
436+instance HasSpiderTimeline x (SpiderHost x) where
437+ {-# INLINE askSpiderTimeline #-}
438+ askSpiderTimeline = SpiderHost ask
447439
448440putCurrentHeight :: Height -> EventM x ()
449441putCurrentHeight h = EventM $ do
@@ -493,7 +485,7 @@ hold v0 e = do
493485 return h
494486
495487{-# INLINE getHoldEventSubscription #-}
496−getHoldEventSubscription :: forall m p a x. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeClear m, R.Patch p, HasCurrentHeight m, Defer SomeMergeInit m, Defer SomeResetCoincidence m, HasSpiderEnv x m) => Hold p a -> m (EventSubscription (p a))
488+getHoldEventSubscription :: forall m p a x. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeClear m, R.Patch p, HasCurrentHeight m, Defer SomeMergeInit m, Defer SomeResetCoincidence m, HasSpiderTimeline x m) => Hold p a -> m (EventSubscription (p a))
497489getHoldEventSubscription h = do
498490 ep <- liftIO $ readIORef $ holdParent h
499491 case ep of
@@ -1030,7 +1022,7 @@ type WeakList a = [Weak a]
10301022#ifdef DEBUG
10311023withIncreasedDepth :: CanTrace x m => m a -> m a
10321024withIncreasedDepth a = do
1033− spiderEnv <- askSpiderEnv
1025+ spiderEnv <- askSpiderTimeline
10341026 liftIO $ modifyIORef' (_spiderEnv_depth spiderEnv) succ
10351027 result <- a
10361028 liftIO $ modifyIORef' (_spiderEnv_depth spiderEnv) pred
@@ -1040,7 +1032,7 @@ withIncreasedDepth :: m a -> m a
10401032withIncreasedDepth = id
10411033#endif
10421034
1043−type CanTrace x m = (HasSpiderEnv x m, MonadIO m)
1035+type CanTrace x m = (HasSpiderTimeline x m, MonadIO m)
10441036
10451037{-# INLINE tracePropagate #-}
10461038tracePropagate :: (CanTrace x m) => String -> m ()
@@ -1063,7 +1055,7 @@ traceMWhen :: (CanTrace x m) => Bool -> m String -> m ()
10631055traceMWhen b getMessage = when b $ do
10641056 message <- getMessage
10651057#ifdef DEBUG
1066− spiderEnv <- askSpiderEnv
1058+ spiderEnv <- askSpiderTimeline
10671059 d <- liftIO $ readIORef $ _spiderEnv_depth spiderEnv
10681060#else
10691061 let d = 0
@@ -1321,7 +1313,7 @@ debugSubscribe = False
13211313
13221314
13231315type CanSubscribe x m =
1324− ( HasSpiderEnv x m
1316+ ( HasSpiderTimeline x m
13251317 , HasCurrentHeight m
13261318 , Defer SomeHoldInit m, Defer SomeMergeInit m -- The things we need to lazily initialize state
13271319 , Defer SomeClear m -- Wiping out event firings
@@ -1487,7 +1479,7 @@ subscribeMergeSubscribed :: MergeSubscribed k -> Subscriber (DMap k Identity) ->
14871479subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed
14881480
14891481{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan k -> Subscriber a -> EventM x (SubscriberListTicket a, FanSubscribed k) #-}
1490−getFanSubscribed :: (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderEnv x m, GCompare k) => k a -> Fan k -> Subscriber a -> m (SubscriberListTicket a, FanSubscribed k)
1482+getFanSubscribed :: (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderTimeline x m, GCompare k) => k a -> Fan k -> Subscriber a -> m (SubscriberListTicket a, FanSubscribed k)
14911483getFanSubscribed k f sub = do
14921484 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
14931485 case mSubscribed of
@@ -1542,7 +1534,7 @@ subscribeFanSubscribed k subscribed sub = do
15421534 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed
15431535
15441536{-# SPECIALIZE getSwitchSubscribed :: Switch a -> Subscriber a -> EventM x (SubscriberListTicket a, SwitchSubscribed a) #-}
1545−getSwitchSubscribed :: (Defer SomeHoldInit m, Defer SomeAssignment m, Defer SomeMergeInit m, Defer SomeClear m, Defer SomeResetCoincidence m, HasCurrentHeight m, HasSpiderEnv x m) => Switch a -> Subscriber a -> m (SubscriberListTicket a, SwitchSubscribed a)
1537+getSwitchSubscribed :: (Defer SomeHoldInit m, Defer SomeAssignment m, Defer SomeMergeInit m, Defer SomeClear m, Defer SomeResetCoincidence m, HasCurrentHeight m, HasSpiderTimeline x m) => Switch a -> Subscriber a -> m (SubscriberListTicket a, SwitchSubscribed a)
15461538getSwitchSubscribed s sub = do
15471539 mSubscribed <- liftIO $ readIORef $ switchSubscribed s
15481540 case mSubscribed of
@@ -1598,7 +1590,7 @@ subscribeSwitchSubscribed :: SwitchSubscribed a -> Subscriber a -> IO (Subscribe
15981590subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed
15991591
16001592{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence a -> Subscriber a -> EventM x (SubscriberListTicket a, CoincidenceSubscribed a) #-}
1601−getCoincidenceSubscribed :: forall x a m. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderEnv x m) => Coincidence a -> Subscriber a -> m (SubscriberListTicket a, CoincidenceSubscribed a)
1593+getCoincidenceSubscribed :: forall x a m. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderTimeline x m) => Coincidence a -> Subscriber a -> m (SubscriberListTicket a, CoincidenceSubscribed a)
16021594getCoincidenceSubscribed c sub = do
16031595 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c
16041596 case mSubscribed of
@@ -1984,18 +1976,18 @@ invalidate toReconnectRef wis = do
19841976--------------------------------------------------------------------------------
19851977
19861978-- | The default, global Spider environment
1987−type Spider = SpiderEnv Global
1979+type Spider = SpiderTimeline Global
19881980
19891981-- | Designates the default, global Spider timeline
19901982data Global
19911983
1992−{-# NOINLINE globalSpiderEnv #-}
1993−globalSpiderEnv :: SpiderEnv Global
1994−globalSpiderEnv = unsafePerformIO unsafeNewSpiderEnv
1984+{-# NOINLINE globalSpiderTimeline #-}
1985+globalSpiderTimeline :: SpiderTimeline Global
1986+globalSpiderTimeline = unsafePerformIO unsafeNewSpiderTimeline
19951987
19961988-- | Stores all global data relevant to a particular Spider timeline; only one
19971989-- value should exist for each type @x@
1998−data SpiderEnv x = SpiderEnv
1990+data SpiderTimeline x = SpiderTimeline
19991991 { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription])
20001992 , _spiderEnv_lock :: !(MVar ())
20011993 , _spiderEnv_cleanups :: !(IORef [IO ()])
@@ -2003,22 +1995,22 @@ data SpiderEnv x = SpiderEnv
20031995 , _spiderEnv_depth :: !(IORef Int)
20041996#endif
20051997 }
2006−type role SpiderEnv nominal
1998+type role SpiderTimeline nominal
20071999
2008−instance GEq SpiderEnv where
2000+instance GEq SpiderTimeline where
20092001 a `geq` b = if _spiderEnv_toUnsubscribe a == _spiderEnv_toUnsubscribe b
2010− then Just $ unsafeCoerce Refl -- This unsafeCoerce is safe because the same SpiderEnv can't have two different 'x' arguments
2002+ then Just $ unsafeCoerce Refl -- This unsafeCoerce is safe because the same SpiderTimeline can't have two different 'x' arguments
20112003 else Nothing
20122004
2013−unsafeNewSpiderEnv :: forall x. IO (SpiderEnv x)
2014−unsafeNewSpiderEnv = do
2005+unsafeNewSpiderTimeline :: forall x. IO (SpiderTimeline x)
2006+unsafeNewSpiderTimeline = do
20152007 toUnsubscribe <- newIORef []
20162008 lock <- newMVar ()
20172009 cleanups <- newIORef []
20182010#ifdef DEBUG
20192011 depthRef <- newIORef 0
20202012#endif
2021− return $ SpiderEnv
2013+ return $ SpiderTimeline
20222014 { _spiderEnv_toUnsubscribe = toUnsubscribe
20232015 , _spiderEnv_lock = lock
20242016 , _spiderEnv_cleanups = cleanups
@@ -2027,21 +2019,21 @@ unsafeNewSpiderEnv = do
20272019#endif
20282020 }
20292021
2030−-- | Create a new SpiderEnv
2031−newSpiderEnv :: IO (Some SpiderEnv)
2032−newSpiderEnv = Some.This <$> unsafeNewSpiderEnv
2022+-- | Create a new SpiderTimeline
2023+newSpiderTimeline :: IO (Some SpiderTimeline)
2024+newSpiderTimeline = Some.This <$> unsafeNewSpiderTimeline
20332025
20342026newtype SpiderPullM x a = SpiderPullM (BehaviorM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
20352027
20362028newtype SpiderPushM x a = SpiderPushM (ComputeM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
20372029
2038−instance R.Reflex (SpiderEnv x) where
2039− newtype Behavior (SpiderEnv x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }
2040− newtype Event (SpiderEnv x) a = SpiderEvent { unSpiderEvent :: Event a }
2041− newtype Dynamic (SpiderEnv x) a = SpiderDynamic { unSpiderDynamic :: Dynamic Identity a } deriving (Functor, Applicative, Monad)
2042− newtype Incremental (SpiderEnv x) p a = SpiderIncremental { unSpiderIncremental :: Dynamic p a }
2043− type PullM (SpiderEnv x) = SpiderPullM x
2044− type PushM (SpiderEnv x) = SpiderPushM x
2030+instance R.Reflex (SpiderTimeline x) where
2031+ newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }
2032+ newtype Event (SpiderTimeline x) a = SpiderEvent { unSpiderEvent :: Event a }
2033+ newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: Dynamic Identity a } deriving (Functor, Applicative, Monad)
2034+ newtype Incremental (SpiderTimeline x) p a = SpiderIncremental { unSpiderIncremental :: Dynamic p a }
2035+ type PullM (SpiderTimeline x) = SpiderPullM x
2036+ type PushM (SpiderTimeline x) = SpiderPushM x
20452037 {-# INLINABLE never #-}
20462038 never = SpiderEvent EventNever
20472039 {-# INLINABLE constant #-}
@@ -2051,13 +2043,13 @@ instance R.Reflex (SpiderEnv x) where
20512043 {-# INLINABLE pull #-}
20522044 pull = SpiderBehavior . pull . coerce
20532045 {-# INLINABLE merge #-}
2054− merge = SpiderEvent . merge . DynamicConst . (unsafeCoerce :: DMap k (R.Event (SpiderEnv x)) -> DMap k Event)
2046+ merge = SpiderEvent . merge . DynamicConst . (unsafeCoerce :: DMap k (R.Event (SpiderTimeline x)) -> DMap k Event)
20552047 {-# INLINABLE fan #-}
20562048 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
20572049 {-# INLINABLE switch #-}
2058− switch = SpiderEvent . switch . (unsafeCoerce :: Behavior (R.Event (SpiderEnv x) a) -> Behavior (Event a)) . unSpiderBehavior
2050+ switch = SpiderEvent . switch . (unsafeCoerce :: Behavior (R.Event (SpiderTimeline x) a) -> Behavior (Event a)) . unSpiderBehavior
20592051 {-# INLINABLE coincidence #-}
2060− coincidence = SpiderEvent . coincidence . (unsafeCoerce :: Event (R.Event (SpiderEnv x) a) -> Event (Event a)) . unSpiderEvent
2052+ coincidence = SpiderEvent . coincidence . (unsafeCoerce :: Event (R.Event (SpiderTimeline x) a) -> Event (Event a)) . unSpiderEvent
20612053 {-# INLINABLE current #-}
20622054 current = SpiderBehavior . current . unSpiderDynamic
20632055 {-# INLINABLE updated #-}
@@ -2067,7 +2059,7 @@ instance R.Reflex (SpiderEnv x) where
20672059 {-# INLINABLE unsafeBuildIncremental #-}
20682060 unsafeBuildIncremental readV0 dv = SpiderIncremental $ DynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
20692061 {-# INLINABLE mergeIncremental #-}
2070− mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic R.PatchDMap (DMap k (R.Event (SpiderEnv x))) -> Dynamic R.PatchDMap (DMap k Event)) . unSpiderIncremental
2062+ mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic R.PatchDMap (DMap k (R.Event (SpiderTimeline x))) -> Dynamic R.PatchDMap (DMap k Event)) . unSpiderIncremental
20712063 {-# INLINABLE currentIncremental #-}
20722064 currentIncremental = SpiderBehavior . current . unSpiderIncremental
20732065 {-# INLINABLE updatedIncremental #-}
@@ -2077,11 +2069,11 @@ instance R.Reflex (SpiderEnv x) where
20772069 c <- readBehaviorUntracked $ current i
20782070 return $ Identity <$> R.apply p c --TODO: Avoid the redundant 'apply'
20792071
2080−instance R.MonadSample (SpiderEnv x) (EventM x) where
2072+instance R.MonadSample (SpiderTimeline x) (EventM x) where
20812073 {-# INLINABLE sample #-}
20822074 sample (SpiderBehavior b) = readBehaviorUntracked b
20832075
2084−instance R.MonadHold (SpiderEnv x) (EventM x) where
2076+instance R.MonadHold (SpiderTimeline x) (EventM x) where
20852077 {-# INLINABLE hold #-}
20862078 hold = holdSpiderEventM
20872079 {-# INLINABLE holdDyn #-}
@@ -2089,16 +2081,16 @@ instance R.MonadHold (SpiderEnv x) (EventM x) where
20892081 {-# INLINABLE holdIncremental #-}
20902082 holdIncremental = holdIncrementalSpiderEventM
20912083
2092−holdSpiderEventM :: a -> R.Event (SpiderEnv x) a -> EventM x (R.Behavior (SpiderEnv x) a)
2084+holdSpiderEventM :: a -> R.Event (SpiderTimeline x) a -> EventM x (R.Behavior (SpiderTimeline x) a)
20932085holdSpiderEventM v0 e = fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e
20942086
2095−holdDynSpiderEventM :: a -> R.Event (SpiderEnv x) a -> EventM x (R.Dynamic (SpiderEnv x) a)
2087+holdDynSpiderEventM :: a -> R.Event (SpiderTimeline x) a -> EventM x (R.Dynamic (SpiderTimeline x) a)
20962088holdDynSpiderEventM v0 e = fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e
20972089
2098−holdIncrementalSpiderEventM :: R.Patch p => a -> R.Event (SpiderEnv x) (p a) -> EventM x (R.Incremental (SpiderEnv x) p a)
2090+holdIncrementalSpiderEventM :: R.Patch p => a -> R.Event (SpiderTimeline x) (p a) -> EventM x (R.Incremental (SpiderTimeline x) p a)
20992091holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e
21002092
2101−instance R.MonadHold (SpiderEnv x) (SpiderHost x) where
2093+instance R.MonadHold (SpiderTimeline x) (SpiderHost x) where
21022094 {-# INLINABLE hold #-}
21032095 hold v0 e = R.runHostFrame $ R.hold v0 e
21042096 {-# INLINABLE holdDyn #-}
@@ -2106,19 +2098,19 @@ instance R.MonadHold (SpiderEnv x) (SpiderHost x) where
21062098 {-# INLINABLE holdIncremental #-}
21072099 holdIncremental v0 e = R.runHostFrame $ R.holdIncremental v0 e
21082100
2109−instance R.MonadSample (SpiderEnv x) (SpiderHost x) where
2101+instance R.MonadSample (SpiderTimeline x) (SpiderHost x) where
21102102 {-# INLINABLE sample #-}
21112103 sample = runFrame . readBehaviorUntracked . unSpiderBehavior
21122104
2113−instance R.MonadSample (SpiderEnv x) (SpiderPullM x) where
2105+instance R.MonadSample (SpiderTimeline x) (SpiderPullM x) where
21142106 {-# INLINABLE sample #-}
21152107 sample = coerce . readBehaviorTracked . unSpiderBehavior
21162108
2117−instance R.MonadSample (SpiderEnv x) (SpiderPushM x) where
2109+instance R.MonadSample (SpiderTimeline x) (SpiderPushM x) where
21182110 {-# INLINABLE sample #-}
21192111 sample (SpiderBehavior b) = SpiderPushM $ readBehaviorUntracked b
21202112
2121−instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where
2113+instance R.MonadHold (SpiderTimeline x) (SpiderPushM x) where
21222114 {-# INLINABLE hold #-}
21232115 hold v0 e = R.current <$> R.holdDyn v0 e
21242116 {-# INLINABLE holdDyn #-}
@@ -2129,18 +2121,18 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where
21292121data RootTrigger a = forall k. GCompare k => RootTrigger (SubscriberList a, IORef (DMap k Identity), k a)
21302122newtype SpiderEventHandle a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription a }
21312123
2132−instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHostFrame x) where
2124+instance R.MonadSubscribeEvent (SpiderTimeline x) (SpiderHostFrame x) where
21332125 {-# INLINABLE subscribeEvent #-}
21342126 subscribeEvent e = SpiderHostFrame $ do
21352127 subscription <- subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)
21362128 return $ SpiderEventHandle subscription
21372129
2138−instance R.ReflexHost (SpiderEnv x) where
2139− type EventTrigger (SpiderEnv x) = RootTrigger
2140− type EventHandle (SpiderEnv x) = SpiderEventHandle
2141− type HostFrame (SpiderEnv x) = SpiderHostFrame x
2130+instance R.ReflexHost (SpiderTimeline x) where
2131+ type EventTrigger (SpiderTimeline x) = RootTrigger
2132+ type EventHandle (SpiderTimeline x) = SpiderEventHandle
2133+ type HostFrame (SpiderTimeline x) = SpiderHostFrame x
21422134
2143−instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where
2135+instance R.MonadReadEvent (SpiderTimeline x) (ReadPhase x) where
21442136 {-# INLINABLE readEvent #-}
21452137 readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do
21462138 let EventSubscription sln subscribed = unSpiderEventHandle h
@@ -2162,7 +2154,7 @@ instance MonadAtomicRef (EventM x) where
21622154 atomicModifyRef r f = liftIO $ atomicModifyRef r f
21632155
21642156-- | The monad for actions that manipulate a Spider timeline identified by @x@
2165−newtype SpiderHost x a = SpiderHost { unSpiderHost :: ReaderT (SpiderEnv x) IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
2157+newtype SpiderHost x a = SpiderHost { unSpiderHost :: ReaderT (SpiderTimeline x) IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
21662158
21672159instance Monad (SpiderHost x) where
21682160 {-# INLINABLE (>>=) #-}
@@ -2177,7 +2169,12 @@ instance Monad (SpiderHost x) where
21772169-- | Run an action affecting the global Spider timeline; this will be guarded by
21782170-- a mutex for that timeline
21792171runSpiderHost :: SpiderHost Global a -> IO a
2180−runSpiderHost (SpiderHost a) = runReaderT a globalSpiderEnv
2172+runSpiderHost (SpiderHost a) = runReaderT a globalSpiderTimeline
2173+
2174+-- | Run an action affecting a given Spider timeline; this will be guarded by a
2175+-- mutex for that timeline
2176+runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimeline x -> IO a
2177+runSpiderHostForTimeline (SpiderHost a) = runReaderT a
21812178
21822179newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
21832180
@@ -2191,14 +2188,14 @@ instance Monad (SpiderHostFrame x) where
21912188 {-# INLINABLE fail #-}
21922189 fail s = SpiderHostFrame $ fail s
21932190
2194−instance R.MonadSample (SpiderEnv x) (SpiderHostFrame x) where
2191+instance R.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
21952192 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can
21962193
21972194addIdentity :: Event a -> Event (Identity a)
21982195--addIdentity = fmap Identity
21992196addIdentity = unsafeCoerce
22002197
2201−instance R.MonadHold (SpiderEnv x) (SpiderHostFrame x) where
2198+instance R.MonadHold (SpiderTimeline x) (SpiderHostFrame x) where
22022199 {-# INLINABLE hold #-}
22032200 hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e
22042201 {-# INLINABLE holdDyn #-}
@@ -2222,34 +2219,34 @@ newFanEventWithTriggerIO f = do
22222219 }
22232220 return $ EventSelector $ \k -> EventRoot k r
22242221
2225−instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHost x) where
2222+instance R.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
22262223 newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO
22272224 newFanEventWithTrigger f = SpiderHost $ lift $ do
22282225 es <- newFanEventWithTriggerIO f
22292226 return $ R.EventSelector $ SpiderEvent . select es
22302227
2231−instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHostFrame x) where
2228+instance R.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
22322229 newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO
22332230 newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do
22342231 es <- newFanEventWithTriggerIO f
22352232 return $ R.EventSelector $ SpiderEvent . select es
22362233
2237−instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHost x) where
2234+instance R.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where
22382235 {-# INLINABLE subscribeEvent #-}
22392236 subscribeEvent = subscribeEventSpiderHost
22402237
2241−subscribeEventSpiderHost :: R.Event (SpiderEnv x) a -> SpiderHost x (R.EventHandle (SpiderEnv x) a)
2238+subscribeEventSpiderHost :: R.Event (SpiderTimeline x) a -> SpiderHost x (R.EventHandle (SpiderTimeline x) a)
22422239subscribeEventSpiderHost e = do
22432240 subscription <- runFrame $ subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)
22442241 return $ SpiderEventHandle subscription
22452242
22462243newtype ReadPhase x a = ReadPhase (ResultM x a) deriving (Functor, Applicative, Monad, MonadFix)
22472244
2248−instance R.MonadSample (SpiderEnv x) (ReadPhase x) where
2245+instance R.MonadSample (SpiderTimeline x) (ReadPhase x) where
22492246 {-# INLINABLE sample #-}
22502247 sample = ReadPhase . R.sample
22512248
2252−instance R.MonadHold (SpiderEnv x) (ReadPhase x) where
2249+instance R.MonadHold (SpiderTimeline x) (ReadPhase x) where
22532250 {-# INLINABLE hold #-}
22542251 hold v0 e = ReadPhase $ R.hold v0 e
22552252 {-# INLINABLE holdDyn #-}
@@ -2257,7 +2254,7 @@ instance R.MonadHold (SpiderEnv x) (ReadPhase x) where
22572254 {-# INLINABLE holdIncremental #-}
22582255 holdIncremental v0 e = ReadPhase $ R.holdIncremental v0 e
22592256
2260−instance R.MonadReflexHost (SpiderEnv x) (SpiderHost x) where
2257+instance R.MonadReflexHost (SpiderTimeline x) (SpiderHost x) where
22612258 type ReadPhase (SpiderHost x) = ReadPhase x
22622259 fireEventsAndRead es (ReadPhase a) = run es a
22632260 runHostFrame = runFrame . runSpiderHostFrame
@@ -2279,3 +2276,10 @@ instance MonadRef (SpiderHostFrame x) where
22792276
22802277instance MonadAtomicRef (SpiderHostFrame x) where
22812278 atomicModifyRef r = SpiderHostFrame . atomicModifyRef r
2279+
2280+--------------------------------------------------------------------------------
2281+-- Deprecated items
2282+--------------------------------------------------------------------------------
2283+
2284+{-# DEPRECATED SpiderEnv "Use 'SpiderTimeline' instead" #-}
2285+type SpiderEnv = SpiderTimeline