7bdc12f · reflex · git.iko.soy

src/Reflex/Class.hs+8−2

@@ -262,8 +262,6 @@ class ( MonadHold t (PushM t)

262 never :: Event t a

263 -- | Create a 'Behavior' that always has the given value

264 constant :: a -> Behavior t a --TODO: Refactor to use 'pure' from Applicative instead; however, we need to make sure that encouraging Applicative-style use of 'Behavior's doesn't have a negative performance impact

265− -- | An event which occurs at the current moment.

266− now :: PushM t (Event t ())

267 -- | Create an 'Event' from another 'Event'; the provided function can sample

265 -- | Create an 'Event' from another 'Event'; the provided function can sample

268 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring

266 -- 'Behavior's and hold 'Event's, and use the results to produce a occurring

269 -- (Just) or non-occurring (Nothing) result

267 -- (Just) or non-occurring (Nothing) result

@@ -422,6 +420,8 @@ class MonadSample t m => MonadHold t m where

422 -- | Create a new 'Event' that only occurs only once, on the first occurrence of

420 -- | Create a new 'Event' that only occurs only once, on the first occurrence of

423 -- the supplied 'Event'.

421 -- the supplied 'Event'.

424 headE :: Event t a -> m (Event t a)

422 headE :: Event t a -> m (Event t a)

423+ -- | An event which occurs at the current moment.

424+ now :: m (Event t ())

425

426-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',

427-- using the combining function to produce a patch.

@@ -567,6 +567,7 @@ instance MonadHold t m => MonadHold t (ReaderT r m) where

567 holdIncremental a0 = lift . holdIncremental a0

568 buildDynamic a0 = lift . buildDynamic a0

569 headE = lift . headE

570+ now = lift now

570

571

571instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where

572instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where

572 sample = lift . sample

573 sample = lift . sample

@@ -577,6 +578,7 @@ instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where

577 holdIncremental a0 = lift . holdIncremental a0

578 holdIncremental a0 = lift . holdIncremental a0

578 buildDynamic a0 = lift . buildDynamic a0

579 buildDynamic a0 = lift . buildDynamic a0

579 headE = lift . headE

580 headE = lift . headE

581+ now = lift now

580

582

581instance MonadSample t m => MonadSample t (StateT s m) where

583instance MonadSample t m => MonadSample t (StateT s m) where

582 sample = lift . sample

584 sample = lift . sample

@@ -587,6 +589,7 @@ instance MonadHold t m => MonadHold t (StateT s m) where

587 holdIncremental a0 = lift . holdIncremental a0

589 holdIncremental a0 = lift . holdIncremental a0

588 buildDynamic a0 = lift . buildDynamic a0

590 buildDynamic a0 = lift . buildDynamic a0

589 headE = lift . headE

591 headE = lift . headE

592+ now = lift now

590

593

591instance MonadSample t m => MonadSample t (ExceptT e m) where

594instance MonadSample t m => MonadSample t (ExceptT e m) where

592 sample = lift . sample

595 sample = lift . sample

@@ -597,6 +600,7 @@ instance MonadHold t m => MonadHold t (ExceptT e m) where

597 holdIncremental a0 = lift . holdIncremental a0

600 holdIncremental a0 = lift . holdIncremental a0

598 buildDynamic a0 = lift . buildDynamic a0

601 buildDynamic a0 = lift . buildDynamic a0

599 headE = lift . headE

602 headE = lift . headE

603+ now = lift now

600

604

601instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where

605instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where

602 sample = lift . sample

606 sample = lift . sample

@@ -607,6 +611,7 @@ instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where

607 holdIncremental a0 = lift . holdIncremental a0

611 holdIncremental a0 = lift . holdIncremental a0

608 buildDynamic a0 = lift . buildDynamic a0

612 buildDynamic a0 = lift . buildDynamic a0

609 headE = lift . headE

613 headE = lift . headE

614+ now = lift now

610

615

611instance MonadSample t m => MonadSample t (ContT r m) where

616instance MonadSample t m => MonadSample t (ContT r m) where

612 sample = lift . sample

617 sample = lift . sample

@@ -617,6 +622,7 @@ instance MonadHold t m => MonadHold t (ContT r m) where

617 holdIncremental a0 = lift . holdIncremental a0

622 holdIncremental a0 = lift . holdIncremental a0

618 buildDynamic a0 = lift . buildDynamic a0

623 buildDynamic a0 = lift . buildDynamic a0

619 headE = lift . headE

624 headE = lift . headE

625+ now = lift now

620

626

621--------------------------------------------------------------------------------

627--------------------------------------------------------------------------------

622-- Convenience functions

628-- Convenience functions

src/Reflex/EventWriter/Base.hs+2

@@ -133,6 +133,8 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where

133 buildDynamic a0 = lift . buildDynamic a0

134 {-# INLINABLE headE #-}

135 headE = lift . headE

136+ {-# INLINABLE now #-}

137+ now = lift now

136

138

137instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

139instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

138 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

140 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

src/Reflex/PerformEvent/Base.hs+2

@@ -164,6 +164,8 @@ instance (ReflexHost t, MonadHold t m) => MonadHold t (PerformEventT t m) where

164 buildDynamic getV0 v' = PerformEventT $ lift $ buildDynamic getV0 v'

165 {-# INLINABLE headE #-}

166 headE = PerformEventT . lift . headE

167+ {-# INLINABLE now #-}

168+ now = PerformEventT . lift $ now

167

169

168instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where

170instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where

169 type Ref (PerformEventT t m) = Ref (HostFrame t)

171 type Ref (PerformEventT t m) = Ref (HostFrame t)

src/Reflex/PostBuild/Base.hs+2

@@ -84,6 +84,8 @@ instance MonadHold t m => MonadHold t (PostBuildT t m) where

84 buildDynamic a0 = lift . buildDynamic a0

85 {-# INLINABLE headE #-}

86 headE = lift . headE

87+ {-# INLINABLE now #-}

88+ now = lift now

87

89

88instance PerformEvent t m => PerformEvent t (PostBuildT t m) where

90instance PerformEvent t m => PerformEvent t (PostBuildT t m) where

89 type Performable (PostBuildT t m) = Performable m

91 type Performable (PostBuildT t m) = Performable m

src/Reflex/Profiled.hs+1−1

@@ -142,7 +142,6 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

142 type PullM (ProfiledTimeline t) = ProfiledM (PullM t)

143 never = Event_Profiled never

144 constant = Behavior_Profiled . constant

145− now = ProfiledM $ Event_Profiled <$> now

146 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us

145 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us

147 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

146 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

148 pull = Behavior_Profiled . pull . coerce

147 pull = Behavior_Profiled . pull . coerce

@@ -184,6 +183,7 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where

184 holdIncremental v0 (Event_Profiled v') = ProfiledM $ Incremental_Profiled <$> holdIncremental v0 v'

183 holdIncremental v0 (Event_Profiled v') = ProfiledM $ Incremental_Profiled <$> holdIncremental v0 v'

185 buildDynamic (ProfiledM v0) (Event_Profiled v') = ProfiledM $ Dynamic_Profiled <$> buildDynamic v0 v'

184 buildDynamic (ProfiledM v0) (Event_Profiled v') = ProfiledM $ Dynamic_Profiled <$> buildDynamic v0 v'

186 headE (Event_Profiled e) = ProfiledM $ Event_Profiled <$> headE e

185 headE (Event_Profiled e) = ProfiledM $ Event_Profiled <$> headE e

186+ now = ProfiledM $ Event_Profiled <$> now

187

188instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

189 sample (Behavior_Profiled b) = ProfiledM $ sample b

src/Reflex/Pure.hs+4−3

@@ -66,9 +66,6 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

66 constant :: a -> Behavior (Pure t) a

67 constant x = Behavior $ \_ -> x

68

69− now :: PushM (Pure t) (Event (Pure t) ())

70− now t = Event $ guard . (t ==)

71−

72 push :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b

69 push :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b

73 push f e = Event $ memo $ \t -> unEvent e t >>= \o -> f o t

70 push f e = Event $ memo $ \t -> unEvent e t >>= \o -> f o t

74

71

@@ -213,3 +210,7 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

213 Just x -> fromMaybe lastValue $ apply x lastValue

210 Just x -> fromMaybe lastValue $ apply x lastValue

214

211

215 headE = slowHeadE

212 headE = slowHeadE

213+ now t = Event $ guard . (t ==)

214+

215+

216+

src/Reflex/Spider/Internal.hs+16−2

@@ -306,6 +306,10 @@ data CacheSubscribed x a

306#endif

307 }

308

309+nowSpiderEventM :: (HasSpiderTimeline x) => EventM x (R.Event (SpiderTimeline x) ())

310+nowSpiderEventM =

311+ SpiderEvent <$> now

312+

309now :: (MonadIO m, Defer (Some Clear) m, HasSpiderTimeline x

313now :: (MonadIO m, Defer (Some Clear) m, HasSpiderTimeline x

310 ) => m (Event x ())

314 ) => m (Event x ())

311now = do

315now = do

@@ -2515,6 +2519,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Event

2515 {-# INLINABLE headE #-}

2519 {-# INLINABLE headE #-}

2516 headE = R.slowHeadE

2520 headE = R.slowHeadE

2517-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

2521-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

2522+ {-# INLINABLE now #-}

2523+ now = nowSpiderEventM

2518

2524

2519instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where

2525instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where

2520 {-# INLINABLE sample #-}

2526 {-# INLINABLE sample #-}

@@ -2536,6 +2542,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

2536 {-# INLINABLE headE #-}

2542 {-# INLINABLE headE #-}

2537 headE = R.slowHeadE

2543 headE = R.slowHeadE

2538-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2544-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2545+ {-# INLINABLE now #-}

2546+ now = SpiderPushM nowSpiderEventM

2547+

2539

2548

2540instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

2549instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

2541 {-# INLINE return #-}

2550 {-# INLINE return #-}

@@ -2599,6 +2608,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

2599 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e

2608 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e

2600 {-# INLINABLE headE #-}

2609 {-# INLINABLE headE #-}

2601 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e

2610 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e

2611+ {-# INLINABLE now #-}

2612+ now = runFrame . runSpiderHostFrame $ Reflex.Class.now

2613+

2602

2614

2603instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

2615instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

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

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

@@ -2615,6 +2627,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

2615 {-# INLINABLE headE #-}

2627 {-# INLINABLE headE #-}

2616 headE = R.slowHeadE

2628 headE = R.slowHeadE

2617-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2629-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2630+ {-# INLINABLE now #-}

2631+ now = SpiderHostFrame Reflex.Class.now

2618

2632

2619instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

2633instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

2620 {-# INLINABLE sample #-}

2634 {-# INLINABLE sample #-}

@@ -2635,6 +2649,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Refle

2635 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e

2649 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e

2636 {-# INLINABLE headE #-}

2650 {-# INLINABLE headE #-}

2637 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e

2651 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e

2652+ {-# INLINABLE now #-}

2653+ now = Reflex.Spider.Internal.ReadPhase Reflex.Class.now

2638

2654

2639--------------------------------------------------------------------------------

2655--------------------------------------------------------------------------------

2640-- Deprecated items

2656-- Deprecated items

@@ -2748,8 +2764,6 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2748 never = SpiderEvent eventNever

2764 never = SpiderEvent eventNever

2749 {-# INLINABLE constant #-}

2765 {-# INLINABLE constant #-}

2750 constant = SpiderBehavior . behaviorConst

2766 constant = SpiderBehavior . behaviorConst

2751− {-# INLINABLE now #-}

2752− now = SpiderPushM (SpiderEvent <$> now)

2753 {-# INLINE push #-}

2767 {-# INLINE push #-}

2754 push f = SpiderEvent . push (coerce f) . unSpiderEvent

2768 push f = SpiderEvent . push (coerce f) . unSpiderEvent

2755 {-# INLINE pushCheap #-}

2769 {-# INLINE pushCheap #-}

src/Reflex/TriggerEvent/Base.hs+2

@@ -122,6 +122,8 @@ instance MonadHold t m => MonadHold t (TriggerEventT t m) where

122 buildDynamic a0 = lift . buildDynamic a0

123 {-# INLINABLE headE #-}

124 headE = lift . headE

125+ {-# INLINABLE now #-}

126+ now = lift now

125

127

126instance Adjustable t m => Adjustable t (TriggerEventT t m) where

128instance Adjustable t m => Adjustable t (TriggerEventT t m) where

127 {-# INLINABLE runWithReplace #-}

129 {-# INLINABLE runWithReplace #-}

test/Reflex/Plan/Pure.hs+1

@@ -41,6 +41,7 @@ instance MonadHold (Pure Int) PurePlan where

41 holdIncremental initial = liftPlan . holdIncremental initial

42 buildDynamic getInitial = liftPlan . buildDynamic getInitial

43 headE = liftPlan . headE

44+ now = liftPlan now

44

45

45instance MonadSample (Pure Int) PurePlan where

46instance MonadSample (Pure Int) PurePlan where

46 sample = liftPlan . sample

47 sample = liftPlan . sample