7bdc12f · reflex · git.iko.soy

git.iko.soy/reflex

Move now to MonadHold and add it to all instances.

commit7bdc12facffd102fc392e813d47f97d39a8d97f3 authorAdriaan Leijnse <parenthetical@users.noreply.github.com> dateMon 11 May 2020, 14:26 (6 years ago) parent4ca8371

9 files changed+38−8

compare with develop

unifiedsplit

src/Reflex/Class.hs+8−2 src/Reflex/EventWriter/Base.hs+2 src/Reflex/PerformEvent/Base.hs+2 src/Reflex/PostBuild/Base.hs+2 src/Reflex/Profiled.hs+1−1 src/Reflex/Pure.hs+4−3 src/Reflex/Spider/Internal.hs+16−2 src/Reflex/TriggerEvent/Base.hs+2 test/Reflex/Plan/Pure.hs+1

src/Reflex/Class.hs+8−2

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

262262 never :: Event t a

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

264264 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 ())

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

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

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

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

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

423421 -- the supplied 'Event'.

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

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

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

425425

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

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

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

567567 holdIncremental a0 = lift . holdIncremental a0

568568 buildDynamic a0 = lift . buildDynamic a0

569569 headE = lift . headE

570+ now = lift now

570571

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

572573 sample = lift . sample

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

577578 holdIncremental a0 = lift . holdIncremental a0

578579 buildDynamic a0 = lift . buildDynamic a0

579580 headE = lift . headE

581+ now = lift now

580582

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

582584 sample = lift . sample

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

587589 holdIncremental a0 = lift . holdIncremental a0

588590 buildDynamic a0 = lift . buildDynamic a0

589591 headE = lift . headE

592+ now = lift now

590593

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

592595 sample = lift . sample

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

597600 holdIncremental a0 = lift . holdIncremental a0

598601 buildDynamic a0 = lift . buildDynamic a0

599602 headE = lift . headE

603+ now = lift now

600604

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

602606 sample = lift . sample

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

607611 holdIncremental a0 = lift . holdIncremental a0

608612 buildDynamic a0 = lift . buildDynamic a0

609613 headE = lift . headE

614+ now = lift now

610615

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

612617 sample = lift . sample

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

617622 holdIncremental a0 = lift . holdIncremental a0

618623 buildDynamic a0 = lift . buildDynamic a0

619624 headE = lift . headE

625+ now = lift now

620626

621627--------------------------------------------------------------------------------

622628-- Convenience functions

src/Reflex/EventWriter/Base.hs+2

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

133133 buildDynamic a0 = lift . buildDynamic a0

134134 {-# INLINABLE headE #-}

135135 headE = lift . headE

136+ {-# INLINABLE now #-}

137+ now = lift now

136138

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

138140 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

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

165165 {-# INLINABLE headE #-}

166166 headE = PerformEventT . lift . headE

167+ {-# INLINABLE now #-}

168+ now = PerformEventT . lift $ now

167169

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

169171 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

8484 buildDynamic a0 = lift . buildDynamic a0

8585 {-# INLINABLE headE #-}

8686 headE = lift . headE

87+ {-# INLINABLE now #-}

88+ now = lift now

8789

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

8991 type Performable (PostBuildT t m) = Performable m

src/Reflex/Profiled.hs+1−1

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

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

143143 never = Event_Profiled never

144144 constant = Behavior_Profiled . constant

145− now = ProfiledM $ Event_Profiled <$> now

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

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

148147 pull = Behavior_Profiled . pull . coerce

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

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

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

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

186+ now = ProfiledM $ Event_Profiled <$> now

187187

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

189189 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

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

6767 constant x = Behavior $ \_ -> x

6868

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

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

71−

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

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

7471

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

213210 Just x -> fromMaybe lastValue $ apply x lastValue

214211

215212 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

306306#endif

307307 }

308308

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

310+nowSpiderEventM =

311+ SpiderEvent <$> now

312+

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

310314 ) => m (Event x ())

311315now = do

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

25152519 {-# INLINABLE headE #-}

25162520 headE = R.slowHeadE

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

2522+ {-# INLINABLE now #-}

2523+ now = nowSpiderEventM

25182524

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

25202526 {-# INLINABLE sample #-}

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

25362542 {-# INLINABLE headE #-}

25372543 headE = R.slowHeadE

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

2545+ {-# INLINABLE now #-}

2546+ now = SpiderPushM nowSpiderEventM

2547+

25392548

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

25412550 {-# INLINE return #-}

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

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

26002609 {-# INLINABLE headE #-}

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

2611+ {-# INLINABLE now #-}

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

2613+

26022614

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

26042616 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

26152627 {-# INLINABLE headE #-}

26162628 headE = R.slowHeadE

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

2630+ {-# INLINABLE now #-}

2631+ now = SpiderHostFrame Reflex.Class.now

26182632

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

26202634 {-# INLINABLE sample #-}

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

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

26362650 {-# INLINABLE headE #-}

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

2652+ {-# INLINABLE now #-}

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

26382654

26392655--------------------------------------------------------------------------------

26402656-- Deprecated items

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

27482764 never = SpiderEvent eventNever

27492765 {-# INLINABLE constant #-}

27502766 constant = SpiderBehavior . behaviorConst

2751− {-# INLINABLE now #-}

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

27532767 {-# INLINE push #-}

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

27552769 {-# INLINE pushCheap #-}

src/Reflex/TriggerEvent/Base.hs+2

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

122122 buildDynamic a0 = lift . buildDynamic a0

123123 {-# INLINABLE headE #-}

124124 headE = lift . headE

125+ {-# INLINABLE now #-}

126+ now = lift now

125127

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

127129 {-# INLINABLE runWithReplace #-}

test/Reflex/Plan/Pure.hs+1

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

4141 holdIncremental initial = liftPlan . holdIncremental initial

4242 buildDynamic getInitial = liftPlan . buildDynamic getInitial

4343 headE = liftPlan . headE

44+ now = liftPlan now

4445

4546instance MonadSample (Pure Int) PurePlan where

4647 sample = liftPlan . sample