@@ -46,8 +46,9 @@ import Control.Monad.Fail (MonadFail)
46import qualified Control.Monad.Fail as MonadFail
46import qualified Control.Monad.Fail as MonadFail
47import Data.Align
47import Data.Align
48import Data.Coerce
48import Data.Coerce
49−import Data.Dependent.Map (DMap, DSum (..))
49+import Data.Dependent.Map (DMap)
50import qualified Data.Dependent.Map as DMap
50import qualified Data.Dependent.Map as DMap
51+import Data.Dependent.Sum (DSum (..))
51import Data.FastMutableIntMap (FastMutableIntMap, PatchIntMap (..))
52import Data.FastMutableIntMap (FastMutableIntMap, PatchIntMap (..))
52import qualified Data.FastMutableIntMap as FastMutableIntMap
53import qualified Data.FastMutableIntMap as FastMutableIntMap
53import Data.Foldable hiding (concat, elem, sequence_)
54import Data.Foldable hiding (concat, elem, sequence_)
@@ -306,7 +307,20 @@ data CacheSubscribed x a
309−
310+nowSpiderEventM :: (HasSpiderTimeline x) => EventM x (R.Event (SpiderTimeline x) ())
314+now :: (MonadIO m, Defer (Some Clear) m, HasSpiderTimeline x
317+ nowOrNot <- liftIO $ newIORef $ Just ()
318+ scheduleClear nowOrNot
319+ return . Event $ \_ -> do
320+ occ <- liftIO . readIORef $ nowOrNot
321+ return ( EventSubscription (return ()) eventSubscribedNow
311-- | Construct an 'Event' whose value is guaranteed not to be recomputed
325-- | Construct an 'Event' whose value is guaranteed not to be recomputed
312-- repeatedly
326-- repeatedly
@@ -450,16 +464,6 @@ data Subscriber x a = Subscriber
450 , subscriberRecalculateHeight :: !(Height -> IO ())
464 , subscriberRecalculateHeight :: !(Height -> IO ())
453−--TODO: Move this comment to WeakBag
454−-- These function are constructor functions that are marked NOINLINE so they are
455−-- opaque to GHC. If we do not do this, then GHC will sometimes fuse the constructor away
456−-- so any weak references that are attached to the constructors will have their
457−-- finalizer run. Using the opaque constructor, does not see the
458−-- constructor application, so it behaves like an IORef and cannot be fused away.
460−-- The result is also evaluated to WHNF, since forcing a thunk invalidates
461−-- the weak pointer to it in some cases.
463newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)
467newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)
464newSubscriberHold h = return $ Subscriber
468newSubscriberHold h = return $ Subscriber
465 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h
469 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h
@@ -603,6 +607,16 @@ eventSubscribedNever = EventSubscribed
603 , eventSubscribedWhoCreated = return ["never"]
607 , eventSubscribedWhoCreated = return ["never"]
610+eventSubscribedNow :: EventSubscribed x
611+eventSubscribedNow = EventSubscribed
612+ { eventSubscribedHeightRef = zeroRef
613+ , eventSubscribedRetained = toAny ()
615+ , eventSubscribedGetParents = return []
616+ , eventSubscribedHasOwnHeightRef = False
617+ , eventSubscribedWhoCreated = return ["now"]
607eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
621eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
608eventSubscribedFan !subscribed = EventSubscribed
622eventSubscribedFan !subscribed = EventSubscribed
@@ -2506,6 +2520,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Event
2506 {-# INLINABLE headE #-}
2520 {-# INLINABLE headE #-}
2507 headE = R.slowHeadE
2521 headE = R.slowHeadE
2508-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e
2522-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e
2523+ {-# INLINABLE now #-}
2524+ now = nowSpiderEventM
2510instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
2526instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where
2511 {-# INLINABLE sample #-}
2527 {-# INLINABLE sample #-}
@@ -2527,6 +2543,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
2527 {-# INLINABLE headE #-}
2543 {-# INLINABLE headE #-}
2528 headE = R.slowHeadE
2544 headE = R.slowHeadE
2529-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e
2545-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e
2546+ {-# INLINABLE now #-}
2547+ now = SpiderPushM nowSpiderEventM
2531instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
2550instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where
2532 {-# INLINE return #-}
2551 {-# INLINE return #-}
@@ -2590,6 +2609,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
2590 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
2609 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e
2591 {-# INLINABLE headE #-}
2610 {-# INLINABLE headE #-}
2592 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e
2611 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e
2612+ {-# INLINABLE now #-}
2613+ now = runFrame . runSpiderHostFrame $ Reflex.Class.now
2594instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
2616instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where
2595 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can
2617 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can
@@ -2606,6 +2628,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide
2606 {-# INLINABLE headE #-}
2628 {-# INLINABLE headE #-}
2607 headE = R.slowHeadE
2629 headE = R.slowHeadE
2608-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e
2630-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e
2631+ {-# INLINABLE now #-}
2632+ now = SpiderHostFrame Reflex.Class.now
2610instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
2634instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where
2611 {-# INLINABLE sample #-}
2635 {-# INLINABLE sample #-}
@@ -2626,6 +2650,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Refle
2626 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e
2650 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e
2627 {-# INLINABLE headE #-}
2651 {-# INLINABLE headE #-}
2628 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e
2652 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e
2653+ {-# INLINABLE now #-}
2654+ now = Reflex.Spider.Internal.ReadPhase Reflex.Class.now
2630--------------------------------------------------------------------------------
2656--------------------------------------------------------------------------------
2631-- Deprecated items
2657-- Deprecated items