c9f42c0 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Expose multi-timeline functionality

c9f42c0Ryan Trinkle10 years ago

src/Reflex/Spider.hs+12−6

compare with develop

unifiedsplit

@@ -1,10 +1,16 @@

1-- | This module exports all of the user-facing functionality of the 'Spider'

2-- 'Reflex' engine

3−module Reflex.Spider ( Spider

3+module Reflex.Spider

4− , SpiderEnv

4+ ( Spider

5+ , SpiderTimeline

5− , Global

6+ , Global

6− , SpiderHost

7+ , SpiderHost

7− , runSpiderHost

8+ , runSpiderHost

9+ , runSpiderHostForTimeline

10+ , newSpiderTimeline

11+ , askSpiderTimeline

12+ -- * Deprecated

13+ , SpiderEnv

8− ) where

14+ ) where

10import Reflex.Spider.Internal

16import Reflex.Spider.Internal

src/Reflex/Spider/Internal.hs+83−79

@@ -20,15 +20,7 @@

20{-# LANGUAGE UndecidableInstances #-}

21-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

22-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

23−module Reflex.Spider.Internal

23+module Reflex.Spider.Internal where

24− ( Spider

25− , SpiderEnv (..)

26− , Global

27− , SpiderHost

28− , runSpiderHost

29− , newSpiderEnv

30− , askSpiderEnv

31− ) where

33import Control.Applicative

25import Control.Applicative

34import Control.Concurrent

26import Control.Concurrent

@@ -374,7 +366,7 @@ data Hold p a

374 }

366 }

375

367

376data EventEnv x

368data EventEnv x

377− = EventEnv { eventEnvSpiderEnv :: !(SpiderEnv x)

369+ = EventEnv { eventEnvSpiderTimeline :: !(SpiderTimeline x)

378 , eventEnvAssignments :: !(IORef [SomeAssignment]) -- Needed for Subscribe

370 , eventEnvAssignments :: !(IORef [SomeAssignment]) -- Needed for Subscribe

379 , eventEnvHoldInits :: !(IORef [SomeHoldInit]) -- Needed for Subscribe

371 , eventEnvHoldInits :: !(IORef [SomeHoldInit]) -- Needed for Subscribe

380 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate])

372 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate])

@@ -433,17 +425,17 @@ instance HasCurrentHeight (EventM x) where

433 delayedRef <- asks eventEnvDelayedMerges

425 delayedRef <- asks eventEnvDelayedMerges

434 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [DelayedMerge subscribed]

426 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [DelayedMerge subscribed]

435

427

436−class HasSpiderEnv x m | m -> x where

428+class HasSpiderTimeline x m | m -> x where

437− -- | Retrieve the current SpiderEnv

429+ -- | Retrieve the current SpiderTimeline

438− askSpiderEnv :: m (SpiderEnv x)

430+ askSpiderTimeline :: m (SpiderTimeline x)

439

431

440−instance HasSpiderEnv x (EventM x) where

432+instance HasSpiderTimeline x (EventM x) where

441− {-# INLINE askSpiderEnv #-}

433+ {-# INLINE askSpiderTimeline #-}

442− askSpiderEnv = EventM $ asks eventEnvSpiderEnv

434+ askSpiderTimeline = EventM $ asks eventEnvSpiderTimeline

443

435

444−instance HasSpiderEnv x (SpiderHost x) where

436+instance HasSpiderTimeline x (SpiderHost x) where

445− {-# INLINE askSpiderEnv #-}

437+ {-# INLINE askSpiderTimeline #-}

446− askSpiderEnv = SpiderHost ask

438+ askSpiderTimeline = SpiderHost ask

447

439

448putCurrentHeight :: Height -> EventM x ()

440putCurrentHeight :: Height -> EventM x ()

449putCurrentHeight h = EventM $ do

441putCurrentHeight h = EventM $ do

@@ -493,7 +485,7 @@ hold v0 e = do

493 return h

485 return h

494

486

495{-# INLINE getHoldEventSubscription #-}

487{-# 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))

497getHoldEventSubscription h = do

489getHoldEventSubscription h = do

498 ep <- liftIO $ readIORef $ holdParent h

490 ep <- liftIO $ readIORef $ holdParent h

499 case ep of

491 case ep of

@@ -1030,7 +1022,7 @@ type WeakList a = [Weak a]

1030#ifdef DEBUG

1022#ifdef DEBUG

1031withIncreasedDepth :: CanTrace x m => m a -> m a

1023withIncreasedDepth :: CanTrace x m => m a -> m a

1032withIncreasedDepth a = do

1024withIncreasedDepth a = do

1033− spiderEnv <- askSpiderEnv

1025+ spiderEnv <- askSpiderTimeline

1034 liftIO $ modifyIORef' (_spiderEnv_depth spiderEnv) succ

1026 liftIO $ modifyIORef' (_spiderEnv_depth spiderEnv) succ

1035 result <- a

1027 result <- a

1036 liftIO $ modifyIORef' (_spiderEnv_depth spiderEnv) pred

1028 liftIO $ modifyIORef' (_spiderEnv_depth spiderEnv) pred

@@ -1040,7 +1032,7 @@ withIncreasedDepth :: m a -> m a

1040withIncreasedDepth = id

1032withIncreasedDepth = id

1041#endif

1033#endif

1042

1034

1043−type CanTrace x m = (HasSpiderEnv x m, MonadIO m)

1035+type CanTrace x m = (HasSpiderTimeline x m, MonadIO m)

1044

1036

1045{-# INLINE tracePropagate #-}

1037{-# INLINE tracePropagate #-}

1046tracePropagate :: (CanTrace x m) => String -> m ()

1038tracePropagate :: (CanTrace x m) => String -> m ()

@@ -1063,7 +1055,7 @@ traceMWhen :: (CanTrace x m) => Bool -> m String -> m ()

1063traceMWhen b getMessage = when b $ do

1055traceMWhen b getMessage = when b $ do

1064 message <- getMessage

1056 message <- getMessage

1065#ifdef DEBUG

1057#ifdef DEBUG

1066− spiderEnv <- askSpiderEnv

1058+ spiderEnv <- askSpiderTimeline

1067 d <- liftIO $ readIORef $ _spiderEnv_depth spiderEnv

1059 d <- liftIO $ readIORef $ _spiderEnv_depth spiderEnv

1068#else

1060#else

1069 let d = 0

1061 let d = 0

@@ -1321,7 +1313,7 @@ debugSubscribe = False

1321

1313

1322

1314

1323type CanSubscribe x m =

1315type CanSubscribe x m =

1324− ( HasSpiderEnv x m

1316+ ( HasSpiderTimeline x m

1325 , HasCurrentHeight m

1317 , HasCurrentHeight m

1326 , Defer SomeHoldInit m, Defer SomeMergeInit m -- The things we need to lazily initialize state

1318 , Defer SomeHoldInit m, Defer SomeMergeInit m -- The things we need to lazily initialize state

1327 , Defer SomeClear m -- Wiping out event firings

1319 , Defer SomeClear m -- Wiping out event firings

@@ -1487,7 +1479,7 @@ subscribeMergeSubscribed :: MergeSubscribed k -> Subscriber (DMap k Identity) ->

1487subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed

1479subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed

1488

1480

1489{-# SPECIALIZE getFanSubscribed :: GCompare k => k a -> Fan k -> Subscriber a -> EventM x (SubscriberListTicket a, FanSubscribed k) #-}

1481{-# 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)

1491getFanSubscribed k f sub = do

1483getFanSubscribed k f sub = do

1492 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

1484 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

1493 case mSubscribed of

1485 case mSubscribed of

@@ -1542,7 +1534,7 @@ subscribeFanSubscribed k subscribed sub = do

1542 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed

1534 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed

1543

1535

1544{-# SPECIALIZE getSwitchSubscribed :: Switch a -> Subscriber a -> EventM x (SubscriberListTicket a, SwitchSubscribed a) #-}

1536{-# 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)

1546getSwitchSubscribed s sub = do

1538getSwitchSubscribed s sub = do

1547 mSubscribed <- liftIO $ readIORef $ switchSubscribed s

1539 mSubscribed <- liftIO $ readIORef $ switchSubscribed s

1548 case mSubscribed of

1540 case mSubscribed of

@@ -1598,7 +1590,7 @@ subscribeSwitchSubscribed :: SwitchSubscribed a -> Subscriber a -> IO (Subscribe

1598subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed

1590subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed

1599

1591

1600{-# SPECIALIZE getCoincidenceSubscribed :: Coincidence a -> Subscriber a -> EventM x (SubscriberListTicket a, CoincidenceSubscribed a) #-}

1592{-# 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)

1602getCoincidenceSubscribed c sub = do

1594getCoincidenceSubscribed c sub = do

1603 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c

1595 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c

1604 case mSubscribed of

1596 case mSubscribed of

@@ -1984,18 +1976,18 @@ invalidate toReconnectRef wis = do

1984--------------------------------------------------------------------------------

1976--------------------------------------------------------------------------------

1985

1977

1986-- | The default, global Spider environment

1978-- | The default, global Spider environment

1987−type Spider = SpiderEnv Global

1979+type Spider = SpiderTimeline Global

1988

1980

1989-- | Designates the default, global Spider timeline

1981-- | Designates the default, global Spider timeline

1990data Global

1982data Global

1991

1983

1992−{-# NOINLINE globalSpiderEnv #-}

1984+{-# NOINLINE globalSpiderTimeline #-}

1993−globalSpiderEnv :: SpiderEnv Global

1985+globalSpiderTimeline :: SpiderTimeline Global

1994−globalSpiderEnv = unsafePerformIO unsafeNewSpiderEnv

1986+globalSpiderTimeline = unsafePerformIO unsafeNewSpiderTimeline

1995

1987

1996-- | Stores all global data relevant to a particular Spider timeline; only one

1988-- | Stores all global data relevant to a particular Spider timeline; only one

1997-- value should exist for each type @x@

1989-- value should exist for each type @x@

1998−data SpiderEnv x = SpiderEnv

1990+data SpiderTimeline x = SpiderTimeline

1999 { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription])

1991 { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription])

2000 , _spiderEnv_lock :: !(MVar ())

1992 , _spiderEnv_lock :: !(MVar ())

2001 , _spiderEnv_cleanups :: !(IORef [IO ()])

1993 , _spiderEnv_cleanups :: !(IORef [IO ()])

@@ -2003,22 +1995,22 @@ data SpiderEnv x = SpiderEnv

2003 , _spiderEnv_depth :: !(IORef Int)

1995 , _spiderEnv_depth :: !(IORef Int)

2004#endif

1996#endif

2005 }

1997 }

2006−type role SpiderEnv nominal

1998+type role SpiderTimeline nominal

2007

1999

2008−instance GEq SpiderEnv where

2000+instance GEq SpiderTimeline where

2009 a `geq` b = if _spiderEnv_toUnsubscribe a == _spiderEnv_toUnsubscribe b

2001 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

2011 else Nothing

2003 else Nothing

2012

2004

2013−unsafeNewSpiderEnv :: forall x. IO (SpiderEnv x)

2005+unsafeNewSpiderTimeline :: forall x. IO (SpiderTimeline x)

2014−unsafeNewSpiderEnv = do

2006+unsafeNewSpiderTimeline = do

2015 toUnsubscribe <- newIORef []

2007 toUnsubscribe <- newIORef []

2016 lock <- newMVar ()

2008 lock <- newMVar ()

2017 cleanups <- newIORef []

2009 cleanups <- newIORef []

2018#ifdef DEBUG

2010#ifdef DEBUG

2019 depthRef <- newIORef 0

2011 depthRef <- newIORef 0

2020#endif

2012#endif

2021− return $ SpiderEnv

2013+ return $ SpiderTimeline

2022 { _spiderEnv_toUnsubscribe = toUnsubscribe

2014 { _spiderEnv_toUnsubscribe = toUnsubscribe

2023 , _spiderEnv_lock = lock

2015 , _spiderEnv_lock = lock

2024 , _spiderEnv_cleanups = cleanups

2016 , _spiderEnv_cleanups = cleanups

@@ -2027,21 +2019,21 @@ unsafeNewSpiderEnv = do

2027#endif

2019#endif

2028 }

2020 }

2029

2021

2030−-- | Create a new SpiderEnv

2022+-- | Create a new SpiderTimeline

2031−newSpiderEnv :: IO (Some SpiderEnv)

2023+newSpiderTimeline :: IO (Some SpiderTimeline)

2032−newSpiderEnv = Some.This <$> unsafeNewSpiderEnv

2024+newSpiderTimeline = Some.This <$> unsafeNewSpiderTimeline

2033

2025

2034newtype SpiderPullM x a = SpiderPullM (BehaviorM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2026newtype SpiderPullM x a = SpiderPullM (BehaviorM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2035

2027

2036newtype SpiderPushM x a = SpiderPushM (ComputeM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2028newtype SpiderPushM x a = SpiderPushM (ComputeM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2037

2029

2038−instance R.Reflex (SpiderEnv x) where

2030+instance R.Reflex (SpiderTimeline x) where

2039− newtype Behavior (SpiderEnv x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }

2031+ newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }

2040− newtype Event (SpiderEnv x) a = SpiderEvent { unSpiderEvent :: Event a }

2032+ newtype Event (SpiderTimeline x) a = SpiderEvent { unSpiderEvent :: Event a }

2041− newtype Dynamic (SpiderEnv x) a = SpiderDynamic { unSpiderDynamic :: Dynamic Identity a } deriving (Functor, Applicative, Monad)

2033+ newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: Dynamic Identity a } deriving (Functor, Applicative, Monad)

2042− newtype Incremental (SpiderEnv x) p a = SpiderIncremental { unSpiderIncremental :: Dynamic p a }

2034+ newtype Incremental (SpiderTimeline x) p a = SpiderIncremental { unSpiderIncremental :: Dynamic p a }

2043− type PullM (SpiderEnv x) = SpiderPullM x

2035+ type PullM (SpiderTimeline x) = SpiderPullM x

2044− type PushM (SpiderEnv x) = SpiderPushM x

2036+ type PushM (SpiderTimeline x) = SpiderPushM x

2045 {-# INLINABLE never #-}

2037 {-# INLINABLE never #-}

2046 never = SpiderEvent EventNever

2038 never = SpiderEvent EventNever

2047 {-# INLINABLE constant #-}

2039 {-# INLINABLE constant #-}

@@ -2051,13 +2043,13 @@ instance R.Reflex (SpiderEnv x) where

2051 {-# INLINABLE pull #-}

2043 {-# INLINABLE pull #-}

2052 pull = SpiderBehavior . pull . coerce

2044 pull = SpiderBehavior . pull . coerce

2053 {-# INLINABLE merge #-}

2045 {-# 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)

2055 {-# INLINABLE fan #-}

2047 {-# INLINABLE fan #-}

2056 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))

2048 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))

2057 {-# INLINABLE switch #-}

2049 {-# 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

2059 {-# INLINABLE coincidence #-}

2051 {-# 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

2061 {-# INLINABLE current #-}

2053 {-# INLINABLE current #-}

2062 current = SpiderBehavior . current . unSpiderDynamic

2054 current = SpiderBehavior . current . unSpiderDynamic

2063 {-# INLINABLE updated #-}

2055 {-# INLINABLE updated #-}

@@ -2067,7 +2059,7 @@ instance R.Reflex (SpiderEnv x) where

2067 {-# INLINABLE unsafeBuildIncremental #-}

2059 {-# INLINABLE unsafeBuildIncremental #-}

2068 unsafeBuildIncremental readV0 dv = SpiderIncremental $ DynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv

2060 unsafeBuildIncremental readV0 dv = SpiderIncremental $ DynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv

2069 {-# INLINABLE mergeIncremental #-}

2061 {-# 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

2071 {-# INLINABLE currentIncremental #-}

2063 {-# INLINABLE currentIncremental #-}

2072 currentIncremental = SpiderBehavior . current . unSpiderIncremental

2064 currentIncremental = SpiderBehavior . current . unSpiderIncremental

2073 {-# INLINABLE updatedIncremental #-}

2065 {-# INLINABLE updatedIncremental #-}

@@ -2077,11 +2069,11 @@ instance R.Reflex (SpiderEnv x) where

2077 c <- readBehaviorUntracked $ current i

2069 c <- readBehaviorUntracked $ current i

2078 return $ Identity <$> R.apply p c --TODO: Avoid the redundant 'apply'

2070 return $ Identity <$> R.apply p c --TODO: Avoid the redundant 'apply'

2079

2071

2080−instance R.MonadSample (SpiderEnv x) (EventM x) where

2072+instance R.MonadSample (SpiderTimeline x) (EventM x) where

2081 {-# INLINABLE sample #-}

2073 {-# INLINABLE sample #-}

2082 sample (SpiderBehavior b) = readBehaviorUntracked b

2074 sample (SpiderBehavior b) = readBehaviorUntracked b

2083

2075

2084−instance R.MonadHold (SpiderEnv x) (EventM x) where

2076+instance R.MonadHold (SpiderTimeline x) (EventM x) where

2085 {-# INLINABLE hold #-}

2077 {-# INLINABLE hold #-}

2086 hold = holdSpiderEventM

2078 hold = holdSpiderEventM

2087 {-# INLINABLE holdDyn #-}

2079 {-# INLINABLE holdDyn #-}

@@ -2089,16 +2081,16 @@ instance R.MonadHold (SpiderEnv x) (EventM x) where

2089 {-# INLINABLE holdIncremental #-}

2081 {-# INLINABLE holdIncremental #-}

2090 holdIncremental = holdIncrementalSpiderEventM

2082 holdIncremental = holdIncrementalSpiderEventM

2091

2083

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)

2093holdSpiderEventM v0 e = fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2085holdSpiderEventM v0 e = fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2094

2086

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)

2096holdDynSpiderEventM v0 e = fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2088holdDynSpiderEventM v0 e = fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2097

2089

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)

2099holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

2091holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

2100

2092

2101−instance R.MonadHold (SpiderEnv x) (SpiderHost x) where

2093+instance R.MonadHold (SpiderTimeline x) (SpiderHost x) where

2102 {-# INLINABLE hold #-}

2094 {-# INLINABLE hold #-}

2103 hold v0 e = R.runHostFrame $ R.hold v0 e

2095 hold v0 e = R.runHostFrame $ R.hold v0 e

2104 {-# INLINABLE holdDyn #-}

2096 {-# INLINABLE holdDyn #-}

@@ -2106,19 +2098,19 @@ instance R.MonadHold (SpiderEnv x) (SpiderHost x) where

2106 {-# INLINABLE holdIncremental #-}

2098 {-# INLINABLE holdIncremental #-}

2107 holdIncremental v0 e = R.runHostFrame $ R.holdIncremental v0 e

2099 holdIncremental v0 e = R.runHostFrame $ R.holdIncremental v0 e

2108

2100

2109−instance R.MonadSample (SpiderEnv x) (SpiderHost x) where

2101+instance R.MonadSample (SpiderTimeline x) (SpiderHost x) where

2110 {-# INLINABLE sample #-}

2102 {-# INLINABLE sample #-}

2111 sample = runFrame . readBehaviorUntracked . unSpiderBehavior

2103 sample = runFrame . readBehaviorUntracked . unSpiderBehavior

2112

2104

2113−instance R.MonadSample (SpiderEnv x) (SpiderPullM x) where

2105+instance R.MonadSample (SpiderTimeline x) (SpiderPullM x) where

2114 {-# INLINABLE sample #-}

2106 {-# INLINABLE sample #-}

2115 sample = coerce . readBehaviorTracked . unSpiderBehavior

2107 sample = coerce . readBehaviorTracked . unSpiderBehavior

2116

2108

2117−instance R.MonadSample (SpiderEnv x) (SpiderPushM x) where

2109+instance R.MonadSample (SpiderTimeline x) (SpiderPushM x) where

2118 {-# INLINABLE sample #-}

2110 {-# INLINABLE sample #-}

2119 sample (SpiderBehavior b) = SpiderPushM $ readBehaviorUntracked b

2111 sample (SpiderBehavior b) = SpiderPushM $ readBehaviorUntracked b

2120

2112

2121−instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where

2113+instance R.MonadHold (SpiderTimeline x) (SpiderPushM x) where

2122 {-# INLINABLE hold #-}

2114 {-# INLINABLE hold #-}

2123 hold v0 e = R.current <$> R.holdDyn v0 e

2115 hold v0 e = R.current <$> R.holdDyn v0 e

2124 {-# INLINABLE holdDyn #-}

2116 {-# INLINABLE holdDyn #-}

@@ -2129,18 +2121,18 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where

2129data RootTrigger a = forall k. GCompare k => RootTrigger (SubscriberList a, IORef (DMap k Identity), k a)

2121data RootTrigger a = forall k. GCompare k => RootTrigger (SubscriberList a, IORef (DMap k Identity), k a)

2130newtype SpiderEventHandle a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription a }

2122newtype SpiderEventHandle a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription a }

2131

2123

2132−instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHostFrame x) where

2124+instance R.MonadSubscribeEvent (SpiderTimeline x) (SpiderHostFrame x) where

2133 {-# INLINABLE subscribeEvent #-}

2125 {-# INLINABLE subscribeEvent #-}

2134 subscribeEvent e = SpiderHostFrame $ do

2126 subscribeEvent e = SpiderHostFrame $ do

2135 subscription <- subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)

2127 subscription <- subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)

2136 return $ SpiderEventHandle subscription

2128 return $ SpiderEventHandle subscription

2137

2129

2138−instance R.ReflexHost (SpiderEnv x) where

2130+instance R.ReflexHost (SpiderTimeline x) where

2139− type EventTrigger (SpiderEnv x) = RootTrigger

2131+ type EventTrigger (SpiderTimeline x) = RootTrigger

2140− type EventHandle (SpiderEnv x) = SpiderEventHandle

2132+ type EventHandle (SpiderTimeline x) = SpiderEventHandle

2141− type HostFrame (SpiderEnv x) = SpiderHostFrame x

2133+ type HostFrame (SpiderTimeline x) = SpiderHostFrame x

2142

2134

2143−instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where

2135+instance R.MonadReadEvent (SpiderTimeline x) (ReadPhase x) where

2144 {-# INLINABLE readEvent #-}

2136 {-# INLINABLE readEvent #-}

2145 readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do

2137 readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do

2146 let EventSubscription sln subscribed = unSpiderEventHandle h

2138 let EventSubscription sln subscribed = unSpiderEventHandle h

@@ -2162,7 +2154,7 @@ instance MonadAtomicRef (EventM x) where

2162 atomicModifyRef r f = liftIO $ atomicModifyRef r f

2154 atomicModifyRef r f = liftIO $ atomicModifyRef r f

2163

2155

2164-- | The monad for actions that manipulate a Spider timeline identified by @x@

2156-- | 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)

2166

2158

2167instance Monad (SpiderHost x) where

2159instance Monad (SpiderHost x) where

2168 {-# INLINABLE (>>=) #-}

2160 {-# INLINABLE (>>=) #-}

@@ -2177,7 +2169,12 @@ instance Monad (SpiderHost x) where

2177-- | Run an action affecting the global Spider timeline; this will be guarded by

2169-- | Run an action affecting the global Spider timeline; this will be guarded by

2178-- a mutex for that timeline

2170-- a mutex for that timeline

2179runSpiderHost :: SpiderHost Global a -> IO a

2171runSpiderHost :: 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

2181

2178

2182newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2179newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2183

2180

@@ -2191,14 +2188,14 @@ instance Monad (SpiderHostFrame x) where

2191 {-# INLINABLE fail #-}

2188 {-# INLINABLE fail #-}

2192 fail s = SpiderHostFrame $ fail s

2189 fail s = SpiderHostFrame $ fail s

2193

2190

2194−instance R.MonadSample (SpiderEnv x) (SpiderHostFrame x) where

2191+instance R.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

2195 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

2192 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

2196

2193

2197addIdentity :: Event a -> Event (Identity a)

2194addIdentity :: Event a -> Event (Identity a)

2198--addIdentity = fmap Identity

2195--addIdentity = fmap Identity

2199addIdentity = unsafeCoerce

2196addIdentity = unsafeCoerce

2200

2197

2201−instance R.MonadHold (SpiderEnv x) (SpiderHostFrame x) where

2198+instance R.MonadHold (SpiderTimeline x) (SpiderHostFrame x) where

2202 {-# INLINABLE hold #-}

2199 {-# INLINABLE hold #-}

2203 hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2200 hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2204 {-# INLINABLE holdDyn #-}

2201 {-# INLINABLE holdDyn #-}

@@ -2222,34 +2219,34 @@ newFanEventWithTriggerIO f = do

2222 }

2219 }

2223 return $ EventSelector $ \k -> EventRoot k r

2220 return $ EventSelector $ \k -> EventRoot k r

2224

2221

2225−instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHost x) where

2222+instance R.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where

2226 newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO

2223 newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO

2227 newFanEventWithTrigger f = SpiderHost $ lift $ do

2224 newFanEventWithTrigger f = SpiderHost $ lift $ do

2228 es <- newFanEventWithTriggerIO f

2225 es <- newFanEventWithTriggerIO f

2229 return $ R.EventSelector $ SpiderEvent . select es

2226 return $ R.EventSelector $ SpiderEvent . select es

2230

2227

2231−instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHostFrame x) where

2228+instance R.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where

2232 newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO

2229 newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO

2233 newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do

2230 newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do

2234 es <- newFanEventWithTriggerIO f

2231 es <- newFanEventWithTriggerIO f

2235 return $ R.EventSelector $ SpiderEvent . select es

2232 return $ R.EventSelector $ SpiderEvent . select es

2236

2233

2237−instance R.MonadSubscribeEvent (SpiderEnv x) (SpiderHost x) where

2234+instance R.MonadSubscribeEvent (SpiderTimeline x) (SpiderHost x) where

2238 {-# INLINABLE subscribeEvent #-}

2235 {-# INLINABLE subscribeEvent #-}

2239 subscribeEvent = subscribeEventSpiderHost

2236 subscribeEvent = subscribeEventSpiderHost

2240

2237

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)

2242subscribeEventSpiderHost e = do

2239subscribeEventSpiderHost e = do

2243 subscription <- runFrame $ subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)

2240 subscription <- runFrame $ subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)

2244 return $ SpiderEventHandle subscription

2241 return $ SpiderEventHandle subscription

2245

2242

2246newtype ReadPhase x a = ReadPhase (ResultM x a) deriving (Functor, Applicative, Monad, MonadFix)

2243newtype ReadPhase x a = ReadPhase (ResultM x a) deriving (Functor, Applicative, Monad, MonadFix)

2247

2244

2248−instance R.MonadSample (SpiderEnv x) (ReadPhase x) where

2245+instance R.MonadSample (SpiderTimeline x) (ReadPhase x) where

2249 {-# INLINABLE sample #-}

2246 {-# INLINABLE sample #-}

2250 sample = ReadPhase . R.sample

2247 sample = ReadPhase . R.sample

2251

2248

2252−instance R.MonadHold (SpiderEnv x) (ReadPhase x) where

2249+instance R.MonadHold (SpiderTimeline x) (ReadPhase x) where

2253 {-# INLINABLE hold #-}

2250 {-# INLINABLE hold #-}

2254 hold v0 e = ReadPhase $ R.hold v0 e

2251 hold v0 e = ReadPhase $ R.hold v0 e

2255 {-# INLINABLE holdDyn #-}

2252 {-# INLINABLE holdDyn #-}

@@ -2257,7 +2254,7 @@ instance R.MonadHold (SpiderEnv x) (ReadPhase x) where

2257 {-# INLINABLE holdIncremental #-}

2254 {-# INLINABLE holdIncremental #-}

2258 holdIncremental v0 e = ReadPhase $ R.holdIncremental v0 e

2255 holdIncremental v0 e = ReadPhase $ R.holdIncremental v0 e

2259

2256

2260−instance R.MonadReflexHost (SpiderEnv x) (SpiderHost x) where

2257+instance R.MonadReflexHost (SpiderTimeline x) (SpiderHost x) where

2261 type ReadPhase (SpiderHost x) = ReadPhase x

2258 type ReadPhase (SpiderHost x) = ReadPhase x

2262 fireEventsAndRead es (ReadPhase a) = run es a

2259 fireEventsAndRead es (ReadPhase a) = run es a

2263 runHostFrame = runFrame . runSpiderHostFrame

2260 runHostFrame = runFrame . runSpiderHostFrame

@@ -2279,3 +2276,10 @@ instance MonadRef (SpiderHostFrame x) where

2279

2276

2280instance MonadAtomicRef (SpiderHostFrame x) where

2277instance MonadAtomicRef (SpiderHostFrame x) where

2281 atomicModifyRef r = SpiderHostFrame . atomicModifyRef r

2278 atomicModifyRef r = SpiderHostFrame . atomicModifyRef r

2279+

2280+--------------------------------------------------------------------------------

2281+-- Deprecated items

2282+--------------------------------------------------------------------------------

2283+

2284+{-# DEPRECATED SpiderEnv "Use 'SpiderTimeline' instead" #-}

2285+type SpiderEnv = SpiderTimeline