@@ -187,38 +187,45 @@ unsafeNodeId a = unsafePerformIO $ do
187187-- Event
188188--------------------------------------------------------------------------------
189189
190−data Event a
191− = forall k. GCompare k => EventRoot !(k a) !(Root k)
192− | EventNever
193− | forall b. EventPush !(Push b a)
194− | forall k. (GCompare k, a ~ DMap k Identity) => EventMerge !(Merge k)
195− | forall k. GCompare k => EventFan !(k a) !(Fan k)
196− | EventSwitch !(Switch a)
197− | EventCoincidence !(Coincidence a)
198− | forall p b. (a ~ p b, R.Patch p) => EventHold !(Hold p b)
199− | forall p b. (a ~ p b, R.Patch p) => EventDyn !(Dyn p b)
200− | forall b. (a ~ Identity b) => EventHoldIdentity !(Hold Identity b)
201− | forall b. (a ~ Identity b) => EventDynIdentity !(Dyn Identity b)
202−
203−{-# SPECIALIZE subscribe :: Event a -> Subscriber a -> EventM x (EventSubscription a) #-}
204−subscribe :: forall x m a. CanSubscribe x m => Event a -> Subscriber a -> m (EventSubscription a)
205−subscribe e sub = case e of
206− EventRoot k r -> wrap EventSubscribedRoot $ liftIO . getRootSubscribed k r
207− EventNever -> return $ EventSubscription Nothing EventSubscribedNever
208− EventPush p -> wrap EventSubscribedPush $ getPushSubscribed p
209− EventFan k f -> wrap (EventSubscribedFan k) $ getFanSubscribed k f
210− EventMerge m -> wrap EventSubscribedMerge $ getMergeSubscribed m
211− EventSwitch s -> wrap EventSubscribedSwitch $ getSwitchSubscribed s
212− EventCoincidence c -> wrap EventSubscribedCoincidence $ getCoincidenceSubscribed c
213− EventHold h -> subscribeHoldEvent h sub
214− EventDyn j -> getDynHold j >>= \h -> subscribeHoldEvent h sub
215− EventHoldIdentity h -> subscribeHoldEvent h sub
216− EventDynIdentity j -> getDynHold j >>= \h -> subscribeHoldEvent h sub
217− where
218− wrap :: (t -> EventSubscribed a) -> (Subscriber a -> m (SubscriberListTicket a, t)) -> m (EventSubscription a)
219− wrap tag getSpecificSubscribed = do
220− (sln, subd) <- getSpecificSubscribed sub
221− return $ EventSubscription (Just sln) $ tag subd
190+newtype Event a = Event { subscribe :: forall x. Subscriber a -> EventM x (EventSubscription a) }
191+
192+wrap :: Monad m => (t -> EventSubscribed a) -> (Subscriber a -> m (SubscriberListTicket a, t)) -> Subscriber a -> m (EventSubscription a)
193+wrap tag getSpecificSubscribed sub = do
194+ (sln, subd) <- getSpecificSubscribed sub
195+ return $ EventSubscription (Just sln) $ tag subd
196+
197+eventRoot :: GCompare k => k a -> Root k -> Event a
198+eventRoot !k !r = Event $ wrap EventSubscribedRoot $ liftIO . getRootSubscribed k r
199+
200+eventNever :: Event a
201+eventNever = Event $ \_ -> return $ EventSubscription Nothing EventSubscribedNever
202+
203+eventPush :: Push b a -> Event a
204+eventPush !p = Event $ wrap EventSubscribedPush $ getPushSubscribed p
205+
206+eventMerge :: (GCompare k, a ~ DMap k Identity) => Merge k -> Event a
207+eventMerge !m = Event $ wrap EventSubscribedMerge $ getMergeSubscribed m
208+
209+eventFan :: GCompare k => k a -> Fan k -> Event a
210+eventFan !k !f = Event $ wrap (EventSubscribedFan k) $ getFanSubscribed k f
211+
212+eventSwitch :: Switch a -> Event a
213+eventSwitch !s = Event $ wrap EventSubscribedSwitch $ getSwitchSubscribed s
214+
215+eventCoincidence :: Coincidence a -> Event a
216+eventCoincidence !c = Event $ wrap EventSubscribedCoincidence $ getCoincidenceSubscribed c
217+
218+eventHold :: (a ~ p b, R.Patch p) => Hold p b -> Event a
219+eventHold !h = Event $ subscribeHoldEvent h
220+
221+eventDyn :: (a ~ p b, R.Patch p) => Dyn p b -> Event a
222+eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub
223+
224+eventHoldIdentity :: (a ~ Identity b) => Hold Identity b -> Event a
225+eventHoldIdentity !h = Event $ subscribeHoldEvent h
226+
227+eventDynIdentity :: (a ~ Identity b) => Dyn Identity b -> Event a
228+eventDynIdentity !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub
222229
223230{-# INLINE subscribeCoincidenceInner #-}
224231subscribeCoincidenceInner :: CanSubscribe x m => Event a -> Height -> CoincidenceSubscribed a -> m (Maybe a, Height, EventSubscribed a)
@@ -493,7 +500,7 @@ hold v0 e = do
493500 return h
494501
495502{-# 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))
503+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, m ~ EventM x) => Hold p a -> m (EventSubscription (p a))
497504getHoldEventSubscription h = do
498505 ep <- liftIO $ readIORef $ holdParent h
499506 case ep of
@@ -835,11 +842,11 @@ current = \case
835842{-# INLINE updated #-}
836843updated :: R.Patch p => Dynamic p a -> Event (p a)
837844updated = \case
838− DynamicHold h -> EventHold h
839− DynamicHoldIdentity h -> EventHoldIdentity h
840− DynamicConst _ -> EventNever
841− DynamicDyn d -> EventDyn d
842− DynamicDynIdentity d -> EventDynIdentity d
845+ DynamicHold h -> eventHold h
846+ DynamicHoldIdentity h -> eventHoldIdentity h
847+ DynamicConst _ -> eventNever
848+ DynamicDyn d -> eventDyn d
849+ DynamicDynIdentity d -> eventDynIdentity d
843850
844851newMapDyn :: (a -> b) -> Dynamic Identity a -> Dynamic Identity b
845852newMapDyn f d = DynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ current d) (Identity . f . runIdentity <$> updated d)
@@ -857,7 +864,7 @@ instance R.FunctorMaybe Event where
857864 fmapMaybe f = push $ return . f
858865
859866instance Align Event where
860− nil = EventNever
867+ nil = eventNever
861868 align ea eb = R.fmapMaybe R.dmapToThese $ merge $ DynamicConst $ DMap.fromList [R.LeftTag :=> ea, R.RightTag :=> eb]
862869
863870--TODO: Avoid the duplication between this and R.zipDynWith
@@ -925,7 +932,7 @@ instance Functor Behavior where
925932
926933{-# NOINLINE push #-} --TODO: If this is helpful, we can get rid of the unsafeNewIORef and use unsafePerformIO directly
927934push :: forall a b. (a -> ComputeM (Maybe b)) -> Event a -> Event b
928−push f e = EventPush $ Push
935+push f e = eventPush $ Push
929936 { pushCompute = f
930937 , pushParent = e
931938 , pushSubscribed = unsafeNewIORef (f, e) Nothing --TODO: Does the use of the tuple here create unnecessary overhead?
@@ -944,13 +951,13 @@ pull a = BehaviorPull $ Pull
944951
945952{-# NOINLINE switch #-}
946953switch :: Behavior (Event a) -> Event a
947−switch a = EventSwitch $ Switch
954+switch a = eventSwitch $ Switch
948955 { switchParent = a
949956 , switchSubscribed = unsafeNewIORef a Nothing
950957 }
951958
952959coincidence :: Event (Event a) -> Event a
953−coincidence a = EventCoincidence $ Coincidence
960+coincidence a = eventCoincidence $ Coincidence
954961 { coincidenceParent = a
955962 , coincidenceSubscribed = unsafeNewIORef a Nothing
956963 }
@@ -1327,6 +1334,7 @@ type CanSubscribe x m =
13271334 , Defer SomeClear m -- Wiping out event firings
13281335 , Defer SomeAssignment m -- Updating state
13291336 , Defer SomeResetCoincidence m
1337+ , m ~ EventM x
13301338 )
13311339
13321340getRootSubscribed :: GCompare k => k a -> Root k -> Subscriber a -> IO (SubscriberListTicket a, RootSubscribed a)
@@ -1487,7 +1495,7 @@ subscribeMergeSubscribed :: MergeSubscribed k -> Subscriber (DMap k Identity) ->
14871495subscribeMergeSubscribed subscribed sub = WeakBag.insert sub (mergeSubscribedSubscribers subscribed) (mergeSubscribedWeakSelf subscribed) cleanupMergeSubscribed
14881496
14891497{-# 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)
1498+getFanSubscribed :: (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeMergeInit m, Defer SomeClear m, HasCurrentHeight m, Defer SomeResetCoincidence m, HasSpiderEnv x m, m ~ EventM x, GCompare k) => k a -> Fan k -> Subscriber a -> m (SubscriberListTicket a, FanSubscribed k)
14911499getFanSubscribed k f sub = do
14921500 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
14931501 case mSubscribed of
@@ -1542,7 +1550,7 @@ subscribeFanSubscribed k subscribed sub = do
15421550 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed
15431551
15441552{-# 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)
1553+getSwitchSubscribed :: (Defer SomeHoldInit m, Defer SomeAssignment m, Defer SomeMergeInit m, Defer SomeClear m, Defer SomeResetCoincidence m, HasCurrentHeight m, HasSpiderEnv x m, m ~ EventM x) => Switch a -> Subscriber a -> m (SubscriberListTicket a, SwitchSubscribed a)
15461554getSwitchSubscribed s sub = do
15471555 mSubscribed <- liftIO $ readIORef $ switchSubscribed s
15481556 case mSubscribed of
@@ -1598,7 +1606,7 @@ subscribeSwitchSubscribed :: SwitchSubscribed a -> Subscriber a -> IO (Subscribe
15981606subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed
15991607
16001608{-# 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)
1609+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, m ~ EventM x) => Coincidence a -> Subscriber a -> m (SubscriberListTicket a, CoincidenceSubscribed a)
16021610getCoincidenceSubscribed c sub = do
16031611 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c
16041612 case mSubscribed of
@@ -1653,7 +1661,7 @@ subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceS
16531661
16541662{-# INLINE merge #-}
16551663merge :: GCompare k => Dynamic R.PatchDMap (DMap k Event) -> Event (DMap k Identity)
1656−merge m = EventMerge $ Merge
1664+merge m = eventMerge $ Merge
16571665 { mergeParents = m
16581666 , mergeSubscribed = unsafeNewIORef m Nothing
16591667 }
@@ -1666,7 +1674,7 @@ fan e =
16661674 { fanParent = e
16671675 , fanSubscribed = unsafeNewIORef e Nothing
16681676 }
1669− in EventSelector $ \k -> EventFan k f
1677+ in EventSelector $ \k -> eventFan k f
16701678
16711679runHoldInits :: IORef [SomeHoldInit] -> IORef [SomeMergeInit] -> EventM x ()
16721680runHoldInits holdInitRef mergeInitRef = do
@@ -2043,7 +2051,7 @@ instance R.Reflex (SpiderEnv x) where
20432051 type PullM (SpiderEnv x) = SpiderPullM x
20442052 type PushM (SpiderEnv x) = SpiderPushM x
20452053 {-# INLINABLE never #-}
2046− never = SpiderEvent EventNever
2054+ never = SpiderEvent eventNever
20472055 {-# INLINABLE constant #-}
20482056 constant = SpiderBehavior . BehaviorConst
20492057 {-# INLINABLE push #-}
@@ -2220,7 +2228,7 @@ newFanEventWithTriggerIO f = do
22202228 , rootSubscribed = subscribedRef
22212229 , rootInit = f
22222230 }
2223− return $ EventSelector $ \k -> EventRoot k r
2231+ return $ EventSelector $ \k -> eventRoot k r
22242232
22252233instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHost x) where
22262234 newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO