@@ -9,7 +9,6 @@
99{-# LANGUAGE GADTs #-}
1010{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1111{-# LANGUAGE LambdaCase #-}
12−{-# LANGUAGE MultiParamTypeClasses #-}
1312{-# LANGUAGE MultiWayIf #-}
1413{-# LANGUAGE RankNTypes #-}
1514{-# LANGUAGE RoleAnnotations #-}
@@ -17,9 +16,15 @@
1716{-# LANGUAGE TypeFamilies #-}
1817{-# LANGUAGE TypeOperators #-}
1918{-# LANGUAGE UndecidableInstances #-}
19+{-# LANGUAGE PolyKinds #-}
20+{-# LANGUAGE DeriveFunctor #-}
21+{-# LANGUAGE StandaloneDeriving #-}
22+{-# LANGUAGE InstanceSigs #-}
23+
2024#ifdef USE_REFLEX_OPTIMIZER
2125{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
2226#endif
27+{-# OPTIONS_GHC -Wunused-binds #-}
2328-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses
2429-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.
2530module Reflex.Spider.Internal (module Reflex.Spider.Internal) where
@@ -33,7 +38,10 @@ import Control.Monad hiding (forM, forM_, mapM, mapM_)
3338import Control.Monad.Exception
3439import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
3540import Control.Monad.Primitive
36−import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)
41+--import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)
42+import Control.Monad.Reader.Class
43+import Control.Monad.IO.Class
44+import Control.Monad.ReaderIO
3745import Control.Monad.Ref
3846import Data.Align
3947import Data.Coerce
@@ -49,6 +57,7 @@ import Data.GADT.Compare
4957import Data.IntMap.Strict (IntMap)
5058import qualified Data.IntMap.Strict as IntMap
5159import Data.IORef
60+import Data.Kind (Type)
5261import Data.Maybe hiding (mapMaybe)
5362import Data.Monoid ((<>))
5463import Data.Proxy
@@ -63,6 +72,15 @@ import System.IO.Unsafe
6372import System.Mem.Weak
6473import Unsafe.Coerce
6574
75+#ifdef MIN_VERSION_semialign
76+#if MIN_VERSION_these(0,8,0)
77+import Data.These.Combinators (justThese)
78+#endif
79+#if MIN_VERSION_semialign(1,1,0)
80+import Data.Zip (Zip (..))
81+#endif
82+#endif
83+
6684#ifdef DEBUG_CYCLES
6785import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence)
6886import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
@@ -76,6 +94,7 @@ import qualified Data.FastWeakBag as FastWeakBag
7694import Data.Reflection
7795import Data.Some (Some(Some))
7896import Data.Type.Coercion
97+import Data.Profunctor.Unsafe ((#.), (.#))
7998import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)
8099import qualified Data.WeakBag as WeakBag
81100import qualified Reflex.Class
@@ -192,12 +211,6 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1
192211
193212newNodeId :: IO Int
194213newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
195−
196−{-# NOINLINE unsafeNodeId #-}
197−unsafeNodeId :: a -> Int
198−unsafeNodeId a = unsafePerformIO $ do
199− touch a
200− newNodeId
201214#endif
202215
203216--------------------------------------------------------------------------------
@@ -301,9 +314,10 @@ cacheEvent e =
301314#else
302315 Event $
303316#endif
304− let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
305− !mSubscribedRef = unsafeNewIORef e emptyFastWeak
306− in \sub -> {-# SCC "cacheEvent" #-} do
317+ unsafePerformIO $ do
318+ mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
319+ <- newIORef emptyFastWeak
320+ pure $ \sub -> {-# SCC "cacheEvent" #-} do
307321#ifdef DEBUG_TRACE_EVENTS
308322 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
309323#endif
@@ -318,9 +332,9 @@ cacheEvent e =
318332 scheduleClear occRef
319333 propagateFast a subscribers
320334 , subscriberInvalidateHeight = \old -> do
321− FastWeakBag.traverse subscribers $ invalidateSubscriberHeight old
335+ FastWeakBag.traverse_ subscribers $ invalidateSubscriberHeight old
322336 , subscriberRecalculateHeight = \new -> do
323− FastWeakBag.traverse subscribers $ recalculateSubscriberHeight new
337+ FastWeakBag.traverse_ subscribers $ recalculateSubscriberHeight new
324338 }
325339 when (isJust occ) $ do
326340 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
@@ -369,7 +383,7 @@ eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed
369383eventNever :: Event x a
370384eventNever = Event $ \_ -> return (EventSubscription (return ()) eventSubscribedNever, Nothing)
371385
372−eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k -> Event x a
386+eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k v -> Event x (v a)
373387eventFan !k !f = Event $ wrap eventSubscribedFan $ getFanSubscribed k f
374388
375389eventSwitch :: HasSpiderTimeline x => Switch x a -> Event x a
@@ -421,14 +435,14 @@ newSubscriberHold h = return $ Subscriber
421435 , subscriberRecalculateHeight = \_ -> return ()
422436 }
423437
424−newSubscriberFan :: forall x k. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k -> IO (Subscriber x (DMap k Identity))
438+newSubscriberFan :: forall x k v. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k v -> IO (Subscriber x (DMap k v))
425439newSubscriberFan subscribed = return $ Subscriber
426440 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
427441 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
428442 tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
429443 liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
430444 scheduleClear $ fanSubscribedOccurrence subscribed
431− let f _ (Pair (Identity v) subsubs) = do
445+ let f _ (Pair v subsubs) = do
432446 propagate v $ _fanSubscribedChildren_list subsubs
433447 return $ Constant ()
434448 _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_
@@ -436,12 +450,12 @@ newSubscriberFan subscribed = return $ Subscriber
436450 , subscriberInvalidateHeight = \old -> do
437451 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
438452 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
439− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old
453+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old
440454 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
441455 , subscriberRecalculateHeight = \new -> do
442456 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
443457 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
444− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new
458+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new
445459 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
446460 }
447461
@@ -457,7 +471,7 @@ newSubscriberSwitch subscribed = return $ Subscriber
457471 oldHeight <- readIORef $ switchSubscribedHeight subscribed
458472 when (oldHeight /= invalidHeight) $ do
459473 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
460− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
474+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
461475 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
462476 , subscriberRecalculateHeight = \new -> do
463477 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
@@ -480,8 +494,8 @@ newSubscriberCoincidenceOuter subscribed = return $ Subscriber
480494 Nothing -> do
481495 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
482496 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight
483− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
484− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
497+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
498+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
485499 Just o -> do -- Since it's already firing, no need to adjust height
486500 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
487501 scheduleClear $ coincidenceSubscribedOccurrence subscribed
@@ -528,14 +542,14 @@ propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
528542propagate a subscribers = withIncreasedDepth $ do
529543 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
530544 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
531− WeakBag.traverse subscribers $ \s -> subscriberPropagate s a
545+ WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
532546
533547-- | Propagate everything at the current height
534548propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
535549propagateFast a subscribers = withIncreasedDepth $ do
536550 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
537551 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
538− FastWeakBag.traverse subscribers $ \s -> subscriberPropagate s a
552+ FastWeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
539553
540554--------------------------------------------------------------------------------
541555-- EventSubscribed
@@ -544,6 +558,11 @@ propagateFast a subscribers = withIncreasedDepth $ do
544558toAny :: a -> Any
545559toAny = unsafeCoerce
546560
561+-- Why do we use Any here, instead of just giving eventSubscribedRetained an
562+-- existential type? Sadly, GHC does not currently know how to unbox types
563+-- with existentially quantified fields. So instead we just coerce values
564+-- to type Any on the way in. Since we never coerce them back, this is
565+-- perfectly safe.
547566data EventSubscribed x = EventSubscribed
548567 { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
549568 , eventSubscribedRetained :: {-# NOUNPACK #-} !Any
@@ -576,7 +595,7 @@ eventSubscribedNever = EventSubscribed
576595#endif
577596 }
578597
579−eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x
598+eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
580599eventSubscribedFan !subscribed = EventSubscribed
581600 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
582601 , eventSubscribedRetained = toAny subscribed
@@ -667,7 +686,7 @@ behaviorPull !p = Behavior $ do
667686 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"
668687 parentsRef <- liftIO $ newIORef []
669688 holdInits <- askBehaviorHoldInits
670− a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)
689+ a <- liftIO $ runReaderIO (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)
671690 invsRef <- liftIO . newIORef . maybeToList =<< askInvalidator
672691 parents <- liftIO $ readIORef parentsRef
673692 let subscribed = PullSubscribed
@@ -702,42 +721,46 @@ readBehaviorUntracked b = do
702721-- Dynamic
703722--------------------------------------------------------------------------------
704723
705−data Dynamic x p = Dynamic
706− { dynamicCurrent :: !(Behavior x (PatchTarget p))
724+type DynamicS x p = Dynamic x (PatchTarget p) p
725+
726+data Dynamic x target p = Dynamic
727+ { dynamicCurrent :: !(Behavior x target)
707728 , dynamicUpdated :: Event x p -- This must be lazy; see the comment on holdEvent --TODO: Would this let us eliminate `Dyn`?
708729 }
709730
710−dynamicHold :: Hold x p -> Dynamic x p
731+deriving instance (HasSpiderTimeline x) => Functor (Dynamic x target)
732+
733+
734+
735+
736+dynamicHold :: Hold x p -> DynamicS x p
711737dynamicHold !h = Dynamic
712738 { dynamicCurrent = behaviorHold h
713739 , dynamicUpdated = eventHold h
714740 }
715741
716−dynamicHoldIdentity :: Hold x (Identity a) -> Dynamic x (Identity a)
742+dynamicHoldIdentity :: Hold x (Identity a) -> DynamicS x (Identity a)
717743dynamicHoldIdentity = dynamicHold
718744
719−dynamicConst :: PatchTarget p -> Dynamic x p
745+dynamicConst :: PatchTarget p -> DynamicS x p
720746dynamicConst !a = Dynamic
721747 { dynamicCurrent = behaviorConst a
722748 , dynamicUpdated = eventNever
723749 }
724750
725−dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Dynamic x p
751+dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> DynamicS x p
726752dynamicDyn !d = Dynamic
727753 { dynamicCurrent = behaviorDyn d
728754 , dynamicUpdated = eventDyn d
729755 }
730756
731−dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> Dynamic x (Identity a)
757+dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> DynamicS x (Identity a)
732758dynamicDynIdentity = dynamicDyn
733759
734760--------------------------------------------------------------------------------
735761-- Combinators
736762--------------------------------------------------------------------------------
737763
738−--TODO: Figure out why certain things are not 'representational', then make them
739−--representational so we can use coerce
740−
741764--type role Hold representational
742765data Hold x p
743766 = Hold { holdValue :: !(IORef (PatchTarget p))
@@ -758,20 +781,25 @@ globalSpiderTimelineEnv = unsafePerformIO unsafeNewSpiderTimelineEnv
758781
759782-- | Stores all global data relevant to a particular Spider timeline; only one
760783-- value should exist for each type @x@
761−data SpiderTimelineEnv x = SpiderTimelineEnv
784+newtype SpiderTimelineEnv x = STE {unSTE :: SpiderTimelineEnv' x}
785+-- We implement SpiderTimelineEnv with a newtype wrapper so
786+-- we can get the coercions we want safely.
787+type role SpiderTimelineEnv nominal
788+
789+data SpiderTimelineEnv' x = SpiderTimelineEnv
762790 { _spiderTimeline_lock :: {-# UNPACK #-} !(MVar ())
763791 , _spiderTimeline_eventEnv :: {-# UNPACK #-} !(EventEnv x)
764792#ifdef DEBUG
765793 , _spiderTimeline_depth :: {-# UNPACK #-} !(IORef Int)
766794#endif
767795 }
768−type role SpiderTimelineEnv nominal
796+type role SpiderTimelineEnv' phantom
769797
770798instance Eq (SpiderTimelineEnv x) where
771799 _ == _ = True -- Since only one exists of each type
772800
773801instance GEq SpiderTimelineEnv where
774− a `geq` b = if _spiderTimeline_lock a == _spiderTimeline_lock b
802+ a `geq` b = if _spiderTimeline_lock (unSTE a) == _spiderTimeline_lock (unSTE b)
775803 then Just $ unsafeCoerce Refl -- This unsafeCoerce is safe because the same SpiderTimelineEnv can't have two different 'x' arguments
776804 else Nothing
777805
@@ -794,7 +822,7 @@ runEventM :: EventM x a -> IO a
794822runEventM = unEventM
795823
796824asksEventEnv :: forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
797−asksEventEnv f = return $ f $ _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)
825+asksEventEnv f = return $ f $ _spiderTimeline_eventEnv (unSTE (spiderTimeline :: SpiderTimelineEnv x))
798826
799827class MonadIO m => Defer a m where
800828 getDeferralQueue :: m (IORef [a])
@@ -932,9 +960,9 @@ getHoldEventSubscription h = do
932960
933961type BehaviorEnv x = (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]), IORef [SomeHoldInit x])
934962
935−--type role BehaviorM representational
936963-- BehaviorM can sample behaviors
937−newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderT (BehaviorEnv x) IO a } deriving (Functor, Applicative, MonadIO, MonadFix)
964+newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderIO (BehaviorEnv x) a }
965+ deriving (Functor, Applicative, MonadIO, MonadFix, MonadReader (BehaviorEnv x))
938966
939967instance Monad (BehaviorM x) where
940968 {-# INLINE (>>=) #-}
@@ -985,7 +1013,7 @@ data RootSubscribed x a = forall k. GCompare k => RootSubscribed
9851013#endif
9861014 }
9871015
988−data Root x (k :: * -> *)
1016+data Root x k
9891017 = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
9901018 , rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))
9911019 , rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))
@@ -1055,25 +1083,25 @@ heightBagVerify b@(HeightBag s c) = if
10551083heightBagVerify = id
10561084#endif
10571085
1058−data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren
1059− { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x a))
1060− , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k)
1061− , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k)))
1086+data FanSubscribedChildren x k v a = FanSubscribedChildren
1087+ { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x (v a)))
1088+ , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k v)
1089+ , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k v)))
10621090 }
10631091
1064−data FanSubscribed (x :: *) k
1065− = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
1066− , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
1067− , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty
1092+data FanSubscribed x k v
1093+ = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
1094+ , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k v)))
1095+ , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k v))) -- This DMap should never be empty
10681096 , fanSubscribedParent :: !(EventSubscription x)
10691097#ifdef DEBUG_NODEIDS
10701098 , fanSubscribedNodeId :: Int
10711099#endif
10721100 }
10731101
1074−data Fan x k
1075− = Fan { fanParent :: !(Event x (DMap k Identity))
1076− , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
1102+data Fan x k v
1103+ = Fan { fanParent :: !(Event x (DMap k v))
1104+ , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
10771105 }
10781106
10791107data SwitchSubscribed x a
@@ -1135,19 +1163,27 @@ instance HasSpiderTimeline x => Align (Event x) where
11351163#if MIN_VERSION_these(0, 8, 0)
11361164instance HasSpiderTimeline x => Semialign (Event x) where
11371165#endif
1138− align ea eb = mapMaybe dmapToThese $ merge $ dynamicConst $ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]
1166+ align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $
1167+ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]
1168+
1169+#ifdef MIN_VERSION_semialign
1170+#if MIN_VERSION_semialign(1,1,0)
1171+instance HasSpiderTimeline x => Zip (Event x) where
1172+#endif
1173+ zip x y = mapMaybe justThese $ align x y
1174+#endif
11391175
11401176data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)
11411177 | BuildDyn !(EventM x (PatchTarget p), Event x p)
11421178 | HoldDyn !(Hold x p)
11431179
1144−newtype Dyn x p = Dyn { unDyn :: IORef (DynType x p) }
1180+newtype Dyn (x :: Type) p = Dyn { unDyn :: IORef (DynType x p) }
11451181
1146−newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)
1182+newMapDyn :: HasSpiderTimeline x => (a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
11471183newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)
11481184
11491185--TODO: Avoid the duplication between this and R.zipDynWith
1150−zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> Dynamic x (Identity a) -> Dynamic x (Identity b) -> Dynamic x (Identity c)
1186+zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> DynamicS x (Identity a) -> DynamicS x (Identity b) -> DynamicS x (Identity c)
11511187zipDynWith f da db =
11521188 let eab = align (dynamicUpdated da) (dynamicUpdated db)
11531189 ec = flip push eab $ \o -> do
@@ -1170,18 +1206,12 @@ buildDynamic readV0 v' = do
11701206 return d
11711207
11721208unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1173−unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
1174− where x = (readV0, v')
1209+unsafeBuildDynamic readV0 v' =
1210+ Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')
11751211
11761212-- ResultM can read behaviors and events
11771213type ResultM = EventM
11781214
1179−{-# NOINLINE unsafeNewIORef #-}
1180−unsafeNewIORef :: a -> b -> IORef b
1181−unsafeNewIORef a b = unsafePerformIO $ do
1182− touch a
1183− newIORef b
1184−
11851215instance HasSpiderTimeline x => Functor (Event x) where
11861216 fmap f = push $ return . Just . f
11871217
@@ -1194,33 +1224,42 @@ push f e = cacheEvent (pushCheap f e)
11941224
11951225{-# INLINABLE pull #-}
11961226pull :: BehaviorM x a -> Behavior x a
1197−pull a = behaviorPull $ Pull
1198− { pullCompute = a
1199− , pullValue = unsafeNewIORef a Nothing
1227+pull a = unsafePerformIO $ do
1228+ ref <- newIORef Nothing
12001229#ifdef DEBUG_NODEIDS
1201− , pullNodeId = unsafeNodeId a
1230+ nid <- newNodeId
12021231#endif
1203− }
1232+ pure $ behaviorPull $ Pull
1233+ { pullCompute = a
1234+ , pullValue = ref
1235+#ifdef DEBUG_NODEIDS
1236+ , pullNodeId = nid
1237+#endif
1238+ }
12041239
12051240{-# INLINABLE switch #-}
12061241switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1207−switch a = eventSwitch $ Switch
1208− { switchParent = a
1209− , switchSubscribed = unsafeNewIORef a Nothing
1210− }
1242+switch a = unsafePerformIO $ do
1243+ ref <- newIORef Nothing
1244+ pure $ eventSwitch $ Switch
1245+ { switchParent = a
1246+ , switchSubscribed = ref
1247+ }
12111248
12121249coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1213−coincidence a = eventCoincidence $ Coincidence
1214− { coincidenceParent = a
1215− , coincidenceSubscribed = unsafeNewIORef a Nothing
1216− }
1250+coincidence a = unsafePerformIO $ do
1251+ ref <- newIORef Nothing
1252+ pure $ eventCoincidence $ Coincidence
1253+ { coincidenceParent = a
1254+ , coincidenceSubscribed = ref
1255+ }
12171256
12181257-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
12191258run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
12201259run roots after = do
12211260 tracePropagate (Proxy :: Proxy x) $ "Running an event frame with " <> show (length roots) <> " events"
12221261 let t = spiderTimeline :: SpiderTimelineEnv x
1223− result <- SpiderHost $ withMVar (_spiderTimeline_lock t) $ \_ -> unSpiderHost $ runFrame $ do
1262+ result <- SpiderHost $ withMVar (_spiderTimeline_lock (unSTE t)) $ \_ -> unSpiderHost $ runFrame $ do
12241263 rootsToPropagate <- forM roots $ \r@(RootTrigger (_, occRef, k) :=> a) -> do
12251264 occBefore <- liftIO $ do
12261265 occBefore <- readIORef occRef
@@ -1284,9 +1323,9 @@ type WeakList a = [Weak a]
12841323withIncreasedDepth :: CanTrace x m => m a -> m a
12851324withIncreasedDepth a = do
12861325 spiderTimeline <- askSpiderTimelineEnv
1287− liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) succ
1326+ liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) succ
12881327 result <- a
1289− liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) pred
1328+ liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) pred
12901329 return result
12911330#else
12921331withIncreasedDepth :: m a -> m a
@@ -1313,7 +1352,7 @@ traceMWhen _ b getMessage = when b $ do
13131352 message <- getMessage
13141353#ifdef DEBUG
13151354 spiderTimeline <- askSpiderTimelineEnv
1316− d <- liftIO $ readIORef $ _spiderTimeline_depth spiderTimeline
1355+ d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE spiderTimeline
13171356#else
13181357 let d = 0
13191358#endif
@@ -1354,25 +1393,25 @@ propagateSubscriberHold h a = do
13541393data SomeResetCoincidence x = forall a. SomeResetCoincidence !(EventSubscription x) !(Maybe (CoincidenceSubscribed x a)) -- The CoincidenceSubscriber will be present only if heights need to be reset
13551394
13561395runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a
1357−runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)
1396+runBehaviorM a mwi holdInits = runReaderIO (unBehaviorM a) (mwi, holdInits)
13581397
13591398askInvalidator :: BehaviorM x (Maybe (Weak (Invalidator x)))
13601399askInvalidator = do
1361− (!m, _) <- BehaviorM ask
1400+ (!m, _) <- ask
13621401 case m of
13631402 Nothing -> return Nothing
13641403 Just (!wi, _) -> return $ Just wi
13651404
13661405askParentsRef :: BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
13671406askParentsRef = do
1368− (!m, _) <- BehaviorM ask
1407+ (!m, _) <- ask
13691408 case m of
13701409 Nothing -> return Nothing
13711410 Just (_, !p) -> return $ Just p
13721411
13731412askBehaviorHoldInits :: BehaviorM x (IORef [SomeHoldInit x])
13741413askBehaviorHoldInits = do
1375− (_, !his) <- BehaviorM ask
1414+ (_, !his) <- ask
13761415 return his
13771416
13781417{-# INLINE getDynHold #-}
@@ -1417,6 +1456,9 @@ getRootSubscribed k r sub = do
14171456 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
14181457 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
14191458 writeIORef uninitRef $! uninit
1459+#ifdef DEBUG_NODEIDS
1460+ nid <- newNodeId
1461+#endif
14201462 let !subscribed = RootSubscribed
14211463 { rootSubscribedKey = k
14221464 , rootSubscribedCachedSubscribed = cached
@@ -1425,7 +1467,7 @@ getRootSubscribed k r sub = do
14251467 , rootSubscribedUninit = uninit
14261468 , rootSubscribedWeakSelf = weakSelf
14271469#ifdef DEBUG_NODEIDS
1428− , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
1470+ , rootSubscribedNodeId = nid
14291471#endif
14301472 }
14311473 -- If we die at the same moment that all our children die, they will
@@ -1474,16 +1516,10 @@ newFanInt = do
14741516 , _fanInt_occRef = occRef
14751517 }
14761518
1477−{-# NOINLINE unsafeNewFanInt #-}
1478−unsafeNewFanInt :: b -> FanInt x a
1479−unsafeNewFanInt b = unsafePerformIO $ do
1480− touch b
1481− newFanInt
1482−
14831519fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1484−fanInt p =
1485− let self = unsafeNewFanInt p
1486− in EventSelectorInt $ \k -> Event $ \sub -> do
1520+fanInt p = unsafePerformIO $ do
1521+ self <- newFanInt
1522+ pure $ EventSelectorInt $ \k -> Event $ \sub -> do
14871523 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
14881524 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
14891525 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
@@ -1491,15 +1527,15 @@ fanInt p =
14911527 liftIO $ writeIORef (_fanInt_occRef self) m
14921528 scheduleIntClear $ _fanInt_occRef self
14931529 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?
1494− FastWeakBag.traverse b $ \s -> do
1530+ FastWeakBag.traverse_ b $ \s -> do
14951531 subscriberPropagate s v
14961532 , subscriberInvalidateHeight = \old -> do
14971533 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1498− FastWeakBag.traverse b $ \s -> do
1534+ FastWeakBag.traverse_ b $ \s -> do
14991535 subscriberInvalidateHeight s old
15001536 , subscriberRecalculateHeight = \new -> do
15011537 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1502− FastWeakBag.traverse b $ \s -> do
1538+ FastWeakBag.traverse_ b $ \s -> do
15031539 subscriberRecalculateHeight s new
15041540 }
15051541 liftIO $ do
@@ -1519,7 +1555,7 @@ fanInt p =
15191555 return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)
15201556
15211557{-# INLINABLE getFanSubscribed #-}
1522−getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, FanSubscribed x k, Maybe a)
1558+getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k v -> Subscriber x (v a) -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
15231559getFanSubscribed k f sub = do
15241560 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
15251561 case mSubscribed of
@@ -1537,13 +1573,16 @@ getFanSubscribed k f sub = do
15371573 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
15381574 occRef <- liftIO $ newIORef parentOcc
15391575 when (isJust parentOcc) $ scheduleClear occRef
1576+#ifdef DEBUG_NODEIDS
1577+ nid <- liftIO newNodeId
1578+#endif
15401579 let subscribed = FanSubscribed
15411580 { fanSubscribedCachedSubscribed = fanSubscribed f
15421581 , fanSubscribedOccurrence = occRef
15431582 , fanSubscribedParent = subscription
15441583 , fanSubscribedSubscribers = subscribersRef
15451584#ifdef DEBUG_NODEIDS
1546− , fanSubscribedNodeId = unsafeNodeId f
1585+ , fanSubscribedNodeId = nid
15471586#endif
15481587 }
15491588 let !self = (k, subscribed)
@@ -1553,7 +1592,7 @@ getFanSubscribed k f sub = do
15531592 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
15541593 return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)
15551594
1556−cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()
1595+cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k v) -> IO ()
15571596cleanupFanSubscribed (k, subscribed) = do
15581597 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
15591598 let reducedSubscribers = DMap.delete k subscribers
@@ -1565,7 +1604,7 @@ cleanupFanSubscribed (k, subscribed) = do
15651604 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers
15661605
15671606{-# INLINE subscribeFanSubscribed #-}
1568−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO WeakBagTicket
1607+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
15691608subscribeFanSubscribed k subscribed sub = do
15701609 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
15711610 case DMap.lookup k subscribers of
@@ -1603,6 +1642,9 @@ getSwitchSubscribed s sub = do
16031642 when (isJust parentOcc) $ scheduleClear occRef
16041643 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
16051644 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1645+#ifdef DEBUG_NODEIDS
1646+ nid <- liftIO newNodeId
1647+#endif
16061648 let !subscribed = SwitchSubscribed
16071649 { switchSubscribedCachedSubscribed = switchSubscribed s
16081650 , switchSubscribedOccurrence = occRef
@@ -1615,7 +1657,7 @@ getSwitchSubscribed s sub = do
16151657 , switchSubscribedCurrentParent = subscriptionRef
16161658 , switchSubscribedWeakSelf = weakSelf
16171659#ifdef DEBUG_NODEIDS
1618− , switchSubscribedNodeId = unsafeNodeId s
1660+ , switchSubscribedNodeId = nid
16191661#endif
16201662 }
16211663 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
@@ -1660,6 +1702,9 @@ getCoincidenceSubscribed c sub = do
16601702 scheduleClear innerSubdRef
16611703 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
16621704 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1705+#ifdef DEBUG_NODEIDS
1706+ nid <- liftIO newNodeId
1707+#endif
16631708 let subscribed = CoincidenceSubscribed
16641709 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
16651710 , coincidenceSubscribedOccurrence = occRef
@@ -1670,7 +1715,7 @@ getCoincidenceSubscribed c sub = do
16701715 , coincidenceSubscribedInnerParent = innerSubdRef
16711716 , coincidenceSubscribedWeakSelf = weakSelf
16721717#ifdef DEBUG_NODEIDS
1673− , coincidenceSubscribedNodeId = unsafeNodeId c
1718+ , coincidenceSubscribedNodeId = nid
16741719#endif
16751720 }
16761721 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
@@ -1687,26 +1732,34 @@ cleanupCoincidenceSubscribed subscribed = do
16871732subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket
16881733subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed
16891734
1690−{-# INLINE merge #-}
1691−merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)
1692−merge d = cacheEvent (mergeCheap d)
1735+{-# INLINE mergeG #-}
1736+mergeG :: forall k q x v. (HasSpiderTimeline x, GCompare k)
1737+ => (forall a. q a -> Event x (v a))
1738+ -> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
1739+mergeG nt d = cacheEvent (mergeCheap nt d)
16931740
16941741{-# INLINE mergeWithMove #-}
1695−mergeWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)
1696−mergeWithMove d = cacheEvent (mergeCheapWithMove d)
1742+mergeWithMove :: forall k v q x. (HasSpiderTimeline x, GCompare k)
1743+ => (forall a. q a -> Event x (v a))
1744+ -> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
1745+mergeWithMove nt d = cacheEvent (mergeCheapWithMove nt d)
16971746
16981747{-# INLINE [1] mergeCheap #-}
1699−mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)
1700−mergeCheap = mergeCheap' getInitialSubscribers updateMe destroy
1748+mergeCheap
1749+ :: forall k x q v. (HasSpiderTimeline x, GCompare k)
1750+ => (forall a. q a -> Event x (v a))
1751+ -> DynamicS x (PatchDMap k q)
1752+ -> Event x (DMap k v)
1753+mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy
17011754 where
1702− updateMe :: MergeUpdateFunc k x (PatchDMap k (Event x)) (MergeSubscribedParent x)
1755+ updateMe :: MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)
17031756 updateMe subscriber heightBagRef oldParents (PatchDMap p) = do
17041757 let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do
17051758 (mOldSubd, newPs) <- case me of
17061759 Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps
17071760 Just e -> do
17081761 let s = subscriber $ return k
1709− subscription@(EventSubscription _ subd) <- subscribe e s
1762+ subscription@(EventSubscription _ subd) <- subscribe (nt e) s
17101763 newParentHeight <- liftIO $ getEventSubscribedHeight subd
17111764 let newParent = MergeSubscribedParent subscription
17121765 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
@@ -1716,28 +1769,33 @@ mergeCheap = mergeCheap' getInitialSubscribers updateMe destroy
17161769 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
17171770 return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)
17181771 foldM f ([], oldParents) $ DMap.toList p
1719− getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParent x)
1772+
1773+ getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParent x)
17201774 getInitialSubscribers initialParents subscriber = do
17211775 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
17221776 let s = subscriber $ return k
1723− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1777+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s
17241778 height <- liftIO $ getEventSubscribedHeight parentSubd
1725− return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription)
1779+ return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParent subscription)
17261780 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
17271781 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
17281782 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers
17291783 )
1784+
17301785 destroy :: MergeDestroyFunc k (MergeSubscribedParent x)
17311786 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParent sub) -> unsubscribe sub
17321787
17331788{-# INLINE [1] mergeCheapWithMove #-}
1734−mergeCheapWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)
1735−mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy
1789+mergeCheapWithMove :: forall k x v q. (HasSpiderTimeline x, GCompare k)
1790+ => (forall a. q a -> Event x (v a))
1791+ -> DynamicS x (PatchDMapWithMove k q)
1792+ -> Event x (DMap k v)
1793+mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy
17361794 where
1737− updateMe :: MergeUpdateFunc k x (PatchDMapWithMove k (Event x)) (MergeSubscribedParentWithMove x k)
1795+ updateMe :: MergeUpdateFunc k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)
17381796 updateMe subscriber heightBagRef oldParents p = do
17391797 -- Prepare new parents for insertion
1740− let subscribeParent :: forall a. k a -> Event x a -> EventM x (MergeSubscribedParentWithMove x k a)
1798+ let subscribeParent :: forall a. k a -> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)
17411799 subscribeParent k e = do
17421800 keyRef <- liftIO $ newIORef k
17431801 let s = subscriber $ liftIO $ readIORef keyRef
@@ -1746,9 +1804,9 @@ mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy
17461804 newParentHeight <- getEventSubscribedHeight subd
17471805 modifyIORef' heightBagRef $ heightBagAdd newParentHeight
17481806 return $ MergeSubscribedParentWithMove subscription keyRef
1749− p' <- PatchDMapWithMove.traversePatchDMapWithMoveWithKey subscribeParent p
1807+ p' <- PatchDMapWithMove.traversePatchDMapWithMoveWithKey (\k q -> subscribeParent k (nt q)) p
17501808 -- Collect old parents for deletion and update the keys of moved parents
1751− let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Event x) a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a
1809+ let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k q a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a
17521810 moveOrDelete _ ni parent = Constant $ case getComposeMaybe $ PatchDMapWithMove._nodeInfo_to ni of
17531811 Nothing -> do
17541812 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription parent
@@ -1759,46 +1817,47 @@ mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy
17591817 return Nothing
17601818 toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $ DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents
17611819 return (toDelete, applyAlways p' oldParents)
1762− getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParentWithMove x k)
1820+ getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)
17631821 getInitialSubscribers initialParents subscriber = do
17641822 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
17651823 keyRef <- liftIO $ newIORef k
17661824 let s = subscriber $ liftIO $ readIORef keyRef
1767− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1825+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s
17681826 height <- liftIO $ getEventSubscribedHeight parentSubd
1769− return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)
1827+ return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)
17701828 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
17711829 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
17721830 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers
17731831 )
1832+
17741833 destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
17751834 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParentWithMove sub _) -> unsubscribe sub
17761835
1777−type MergeUpdateFunc k x p s
1778− = (forall a. EventM x (k a) -> Subscriber x a)
1836+type MergeUpdateFunc k v x p s
1837+ = (forall a. EventM x (k a) -> Subscriber x (v a))
17791838 -> IORef HeightBag
17801839 -> DMap k s
17811840 -> p
17821841 -> EventM x ([EventSubscription x], DMap k s)
17831842
1784−type MergeInitFunc k x s
1785− = DMap k (Event x)
1786− -> (forall a. EventM x (k a) -> Subscriber x a)
1787− -> EventM x (DMap k Identity, [Height], DMap k s)
1843+type MergeInitFunc k v q x s
1844+ = DMap k q
1845+ -> (forall a. EventM x (k a) -> Subscriber x (v a))
1846+ -> EventM x (DMap k v, [Height], DMap k s)
17881847
17891848type MergeDestroyFunc k s
17901849 = DMap k s
17911850 -> IO ()
17921851
1793−data Merge x k s = Merge
1852+data Merge x k v s = Merge
17941853 { _merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))
17951854 , _merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)
17961855 , _merge_heightRef :: {-# UNPACK #-} !(IORef Height)
1797− , _merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k Identity))
1798− , _merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k Identity))
1856+ , _merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k v))
1857+ , _merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k v))
17991858 }
18001859
1801−invalidateMergeHeight :: Merge x k s -> IO ()
1860+invalidateMergeHeight :: Merge x k v s -> IO ()
18021861invalidateMergeHeight m = invalidateMergeHeight' (_merge_heightRef m) (_merge_sub m)
18031862
18041863invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()
@@ -1808,8 +1867,7 @@ invalidateMergeHeight' heightRef sub = do
18081867 writeIORef heightRef $! invalidHeight
18091868 subscriberInvalidateHeight sub oldHeight
18101869
1811−
1812−revalidateMergeHeight :: Merge x k s -> IO ()
1870+revalidateMergeHeight :: Merge x k v s -> IO ()
18131871revalidateMergeHeight m = do
18141872 currentHeight <- readIORef $ _merge_heightRef m
18151873 when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check
@@ -1825,19 +1883,19 @@ revalidateMergeHeight m = do
18251883 subscriberRecalculateHeight (_merge_sub m) height
18261884 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"
18271885
1828−scheduleMergeSelf :: HasSpiderTimeline x => Merge x k s -> Height -> EventM x ()
1886+scheduleMergeSelf :: HasSpiderTimeline x => Merge x k v s -> Height -> EventM x ()
18291887scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do
18301888 vals <- liftIO $ readIORef $ _merge_accumRef m
18311889 liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us, it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers
18321890 --TODO: Assert that m is not empty
18331891 subscriberPropagate (_merge_sub m) vals
18341892
1835−mergeSubscriber :: forall x k s a. (HasSpiderTimeline x, GCompare k) => Merge x k s -> EventM x (k a) -> Subscriber x a
1893+mergeSubscriber :: forall x k v s a. (HasSpiderTimeline x, GCompare k) => Merge x k v s -> EventM x (k a) -> Subscriber x (v a)
18361894mergeSubscriber m getKey = Subscriber
18371895 { subscriberPropagate = \a -> do
18381896 oldM <- liftIO $ readIORef $ _merge_accumRef m
18391897 k <- getKey
1840− let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k (Identity a) oldM
1898+ let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k a oldM
18411899 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)
18421900 liftIO $ writeIORef (_merge_accumRef m) $! newM
18431901 when (DMap.null oldM) $ do -- Only schedule the firing once
@@ -1868,7 +1926,7 @@ mergeSubscriber m getKey = Subscriber
18681926 }
18691927
18701928--TODO: Be able to run as much of this as possible promptly
1871−updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k s -> MergeUpdateFunc k x p s -> p -> SomeMergeUpdate x
1929+updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k v s -> MergeUpdateFunc k v x p s -> p -> SomeMergeUpdate x
18721930updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)
18731931 where updateMe = do
18741932 oldParents <- liftIO $ readIORef $ _merge_parentsRef m
@@ -1876,9 +1934,10 @@ updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m)
18761934 liftIO $ writeIORef (_merge_parentsRef m) $! newParents
18771935 return subscriptionsToKill
18781936
1879−{-# INLINE mergeCheap' #-}
1880−mergeCheap' :: forall k x p s. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k (Event x)) => MergeInitFunc k x s -> MergeUpdateFunc k x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k Identity)
1881−mergeCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
1937+{-# INLINE mergeGCheap' #-}
1938+mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)
1939+ => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v)
1940+mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
18821941 initialParents <- readBehaviorUntracked $ dynamicCurrent d
18831942 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
18841943 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"
@@ -1926,11 +1985,11 @@ mergeCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
19261985 , occ
19271986 )
19281987
1929−mergeInt :: forall x a. (HasSpiderTimeline x) => Dynamic x (PatchIntMap (Event x a)) -> Event x (IntMap a)
1988+mergeInt :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
19301989mergeInt = cacheEvent . mergeIntCheap
19311990
19321991{-# INLINABLE mergeIntCheap #-}
1933−mergeIntCheap :: forall x a. (HasSpiderTimeline x) => Dynamic x (PatchIntMap (Event x a)) -> Event x (IntMap a)
1992+mergeIntCheap :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
19341993mergeIntCheap d = Event $ \sub -> do
19351994 initialParents <- readBehaviorUntracked $ dynamicCurrent d
19361995 accum <- liftIO $ FastMutableIntMap.newEmpty
@@ -2027,14 +2086,16 @@ mergeIntCheap d = Event $ \sub -> do
20272086 )
20282087
20292088newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }
2089+newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
20302090
2031−fan :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k Identity) -> EventSelector x k
2032−fan e =
2091+fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2092+fanG e = unsafePerformIO $ do
2093+ ref <- newIORef Nothing
20332094 let f = Fan
20342095 { fanParent = e
2035− , fanSubscribed = unsafeNewIORef e Nothing
2096+ , fanSubscribed = ref
20362097 }
2037− in EventSelector $ \k -> eventFan k f
2098+ pure $ EventSelectorG $ \k -> eventFan k f
20382099
20392100runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
20402101runHoldInits holdInitRef dynInitRef mergeInitRef = do
@@ -2088,7 +2149,7 @@ clearEventEnv (EventEnv toAssignRef holdInitRef dynInitRef mergeUpdateRef mergeI
20882149-- | Run an event action outside of a frame
20892150runFrame :: forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex
20902151runFrame a = SpiderHost $ do
2091− let env = _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)
2152+ let env = _spiderTimeline_eventEnv $ unSTE (spiderTimeline :: SpiderTimelineEnv x)
20922153 let go = do
20932154 result <- a
20942155 runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events
@@ -2146,7 +2207,7 @@ runFrame a = SpiderHost $ do
21462207 myHeight <- readIORef $ switchSubscribedHeight subscribed
21472208 when (parentHeight /= myHeight) $ do
21482209 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
2149− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
2210+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
21502211 mapM_ _someMergeUpdate_invalidateHeight mergeUpdates --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different
21512212 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do
21522213 unsubscribe subscription
@@ -2187,7 +2248,7 @@ invalidateCoincidenceHeight subscribed = do
21872248 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed
21882249 when (oldHeight /= invalidHeight) $ do
21892250 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight
2190− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
2251+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
21912252
21922253updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
21932254updateSwitchHeight new subscribed = do
@@ -2195,7 +2256,7 @@ updateSwitchHeight new subscribed = do
21952256 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
21962257 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion
21972258 writeIORef (switchSubscribedHeight subscribed) $! new
2198− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
2259+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
21992260
22002261recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
22012262recalculateCoincidenceHeight subscribed = do
@@ -2204,7 +2265,7 @@ recalculateCoincidenceHeight subscribed = do
22042265 height <- calculateCoincidenceHeight subscribed
22052266 when (height /= invalidHeight) $ do
22062267 writeIORef (coincidenceSubscribedHeight subscribed) $! height
2207− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
2268+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
22082269
22092270calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
22102271calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)
@@ -2299,7 +2360,7 @@ instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x))
22992360 fail _ = error "Dynamic does not support 'fail'"
23002361
23012362{-# INLINABLE newJoinDyn #-}
2302−newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
2363+newJoinDyn :: HasSpiderTimeline x => DynamicS x (Identity (DynamicS x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
23032364newJoinDyn d =
23042365 let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)
23052366 eOuter = Reflex.Spider.Internal.push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d
@@ -2449,7 +2510,7 @@ unsafeNewSpiderTimelineEnv = do
24492510#ifdef DEBUG
24502511 depthRef <- newIORef 0
24512512#endif
2452− return $ SpiderTimelineEnv
2513+ return $ STE $ SpiderTimelineEnv
24532514 { _spiderTimeline_lock = lock
24542515 , _spiderTimeline_eventEnv = env
24552516#ifdef DEBUG
@@ -2461,17 +2522,17 @@ unsafeNewSpiderTimelineEnv = do
24612522newSpiderTimeline :: IO (Some SpiderTimelineEnv)
24622523newSpiderTimeline = withSpiderTimeline (pure . Some)
24632524
2464−data LocalSpiderTimeline x s
2525+data LocalSpiderTimeline (x :: Type) s
24652526
24662527instance Reifies s (SpiderTimelineEnv x) =>
24672528 HasSpiderTimeline (LocalSpiderTimeline x s) where
2468− spiderTimeline = localSpiderTimeline (Proxy :: Proxy s) $ reflect (Proxy :: Proxy s)
2529+ spiderTimeline = localSpiderTimeline Proxy $ reflect (Proxy :: Proxy s)
24692530
24702531localSpiderTimeline
2471− :: Proxy s
2532+ :: proxy s
24722533 -> SpiderTimelineEnv x
24732534 -> SpiderTimelineEnv (LocalSpiderTimeline x s)
2474−localSpiderTimeline _ = unsafeCoerce
2535+localSpiderTimeline _ = coerce
24752536
24762537-- | Pass a new timeline to the given function.
24772538withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r) -> IO r
@@ -2479,18 +2540,18 @@ withSpiderTimeline k = do
24792540 env <- unsafeNewSpiderTimelineEnv
24802541 reify env $ \s -> k $ localSpiderTimeline s env
24812542
2482−newtype SpiderPullM x a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
2543+newtype SpiderPullM (x :: Type) a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
24832544
24842545type ComputeM = EventM
24852546
2486−newtype SpiderPushM x a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
2547+newtype SpiderPushM (x :: Type) a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
24872548
24882549instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
24892550 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}
24902551 newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior x a }
24912552 newtype Event (SpiderTimeline x) a = SpiderEvent { unSpiderEvent :: Event x a }
2492− newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: Dynamic x (Identity a) } -- deriving (Functor, Applicative, Monad)
2493− newtype Incremental (SpiderTimeline x) p = SpiderIncremental { unSpiderIncremental :: Dynamic x p }
2553+ newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: DynamicS x (Identity a) } -- deriving (Functor, Applicative, Monad)
2554+ newtype Incremental (SpiderTimeline x) p = SpiderIncremental { unSpiderIncremental :: DynamicS x p }
24942555 type PullM (SpiderTimeline x) = SpiderPullM x
24952556 type PushM (SpiderTimeline x) = SpiderPushM x
24962557 {-# INLINABLE never #-}
@@ -2503,10 +2564,15 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25032564 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent
25042565 {-# INLINABLE pull #-}
25052566 pull = SpiderBehavior . pull . coerce
2506− {-# INLINABLE merge #-}
2507− merge = SpiderEvent . merge . dynamicConst . (coerce :: DMap k (R.Event (SpiderTimeline x)) -> DMap k (Event x))
2508− {-# INLINABLE fan #-}
2509− fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
2567+ {-# INLINABLE fanG #-}
2568+ fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))
2569+ {-# INLINABLE mergeG #-}
2570+ mergeG
2571+ :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k
2572+ => (forall a. q a -> R.Event (SpiderTimeline x) (v a))
2573+ -> DMap k q
2574+ -> R.Event (SpiderTimeline x) (DMap k v)
2575+ mergeG nt = SpiderEvent . mergeG (unSpiderEvent #. nt) . dynamicConst
25102576 {-# INLINABLE switch #-}
25112577 switch = SpiderEvent . switch . (coerce :: Behavior x (R.Event (SpiderTimeline x) a) -> Behavior x (Event x a)) . unSpiderBehavior
25122578 {-# INLINABLE coincidence #-}
@@ -2514,15 +2580,15 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25142580 {-# INLINABLE current #-}
25152581 current = SpiderBehavior . dynamicCurrent . unSpiderDynamic
25162582 {-# INLINABLE updated #-}
2517− updated = coerce $ SpiderEvent . dynamicUpdated . unSpiderDynamic
2583+ updated = SpiderEvent #. dynamicUpdated .# fmap coerce . unSpiderDynamic
25182584 {-# INLINABLE unsafeBuildDynamic #-}
25192585 unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'
25202586 {-# INLINABLE unsafeBuildIncremental #-}
25212587 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv
2522− {-# INLINABLE mergeIncremental #-}
2523− mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental
2524− {-# INLINABLE mergeIncrementalWithMove #-}
2525− mergeIncrementalWithMove = SpiderEvent . mergeWithMove . (unsafeCoerce :: Dynamic x (PatchDMapWithMove k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMapWithMove k (Event x))) . unSpiderIncremental
2588+ {-# INLINABLE mergeIncrementalG #-}
2589+ mergeIncrementalG nt = SpiderEvent #. mergeG (coerce #. nt) .# unSpiderIncremental
2590+ {-# INLINABLE mergeIncrementalWithMoveG #-}
2591+ mergeIncrementalWithMoveG nt = SpiderEvent #. mergeWithMove (coerce #. nt) .# unSpiderIncremental
25262592 {-# INLINABLE currentIncremental #-}
25272593 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
25282594 {-# INLINABLE updatedIncremental #-}
@@ -2533,9 +2599,10 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25332599 return $ Identity <$> apply p c --TODO: Avoid the redundant 'apply'
25342600 eventCoercion Coercion = Coercion
25352601 behaviorCoercion Coercion = Coercion
2536− dynamicCoercion = unsafeCoerce --TODO: How can we avoid this unsafeCoerce? This is safe only because we know how Identity works as a Patch instance
2602+ dynamicCoercion Coercion = Coercion
2603+ incrementalCoercion Coercion Coercion = Coercion
25372604 {-# INLINABLE mergeIntIncremental #-}
2538− mergeIntIncremental = SpiderEvent . mergeInt . (unsafeCoerce :: Dynamic x (PatchIntMap (R.Event (SpiderTimeline x) a)) -> Dynamic x (PatchIntMap (Event x a))) . unSpiderIncremental
2605+ mergeIntIncremental = SpiderEvent . mergeInt . coerce
25392606 {-# INLINABLE fanInt #-}
25402607 fanInt e = R.EventSelectorInt $ SpiderEvent . selectInt (fanInt (unSpiderEvent e))
25412608
@@ -2560,7 +2627,7 @@ instance MonadAtomicRef (EventM x) where
25602627 atomicModifyRef r f = liftIO $ atomicModifyRef r f
25612628
25622629-- | The monad for actions that manipulate a Spider timeline identified by @x@
2563−newtype SpiderHost x a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
2630+newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
25642631
25652632instance Monad (SpiderHost x) where
25662633 {-# INLINABLE (>>=) #-}
@@ -2582,7 +2649,7 @@ runSpiderHost (SpiderHost a) = a
25822649runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a
25832650runSpiderHostForTimeline (SpiderHost a) _ = a
25842651
2585−newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }
2652+newtype SpiderHostFrame (x :: Type) a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }
25862653 deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
25872654
25882655instance Monad (SpiderHostFrame x) where