168b4cd · reflex · git.iko.soy

git.iko.soy/reflex

Actually use the new headE

commit168b4cd161dd908f7079dbbfd1573f70464e04af authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 12 Sep 2017, 18:46 (9 years ago) parent68a75c8

5 files changed+26−5

compare with develop

unifiedsplit

src/Reflex/Class.hs+11−5 src/Reflex/PerformEvent/Base.hs+2 src/Reflex/Pure.hs+2 src/Reflex/Spider/SpiderTimeline.include.hs+10 test/Reflex/Plan/Pure.hs+1

src/Reflex/Class.hs+11−5

@@ -136,6 +136,8 @@ module Reflex.Class

136136 , tagCheap

137137 , mergeWithCheap

138138 , mergeWithCheap'

139+ -- * Slow, but general, implementations

140+ , slowHeadE

139141#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

140142 , Spider

141143 , SpiderEnv

@@ -456,16 +458,20 @@ class MonadSample t m => MonadHold t m where

456458 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)

457459 holdIncremental v0 = lift . holdIncremental v0

458460 buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)

461+ {-

459462 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)

460463 buildDynamic getV0 = lift . buildDynamic getV0

464+ -}

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

462466 -- the supplied 'Event'.

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

464− default headE :: (Reflex t, MonadFix m) => Event t a -> m (Event t a)

465− headE e = do

466− rec be <- hold e $ fmapCheap (const never) e'

467− let e' = switch be

468− return e'

468+

469+

470+slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

471+slowHeadE e = do

472+ rec be <- hold e $ fmapCheap (const never) e'

473+ let e' = switch be

474+ return e'

469475

470476-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a

471477-- key. This is much more efficient than filtering for each key with

src/Reflex/PerformEvent/Base.hs+2

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

159159 holdIncremental v0 v' = PerformEventT $ lift $ holdIncremental v0 v'

160160 {-# INLINABLE buildDynamic #-}

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

162+ {-# INLINABLE headE #-}

163+ headE = PerformEventT . lift . headE

162164

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

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

src/Reflex/Pure.hs+2

@@ -202,3 +202,5 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

202202 in case unEvent e lastTime of

203203 Nothing -> lastValue

204204 Just x -> fromMaybe lastValue $ apply x lastValue

205+

206+ headE = slowHeadE

src/Reflex/Spider/SpiderTimeline.include.hs+10

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

1818 holdIncremental = holdIncrementalSpiderEventM

1919 {-# INLINABLE buildDynamic #-}

2020 buildDynamic = buildDynamicSpiderEventM

21+ {-# INLINABLE headE #-}

22+ headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

2123

2224instance (

2325#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

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

4648 holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> Reflex.Spider.Internal.hold v0 e

4749 {-# INLINABLE buildDynamic #-}

4850 buildDynamic getV0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce e

51+ {-# INLINABLE headE #-}

52+ headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

4953

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

5155 {-# INLINE return #-}

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

101105 holdIncremental v0 e = runFrame . runSpiderHostFrame $ Reflex.Class.holdIncremental v0 e

102106 {-# INLINABLE buildDynamic #-}

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

108+ {-# INLINABLE headE #-}

109+ headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e

104110

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

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

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

114120 holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

115121 {-# INLINABLE buildDynamic #-}

116122 buildDynamic getV0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

123+ {-# INLINABLE headE #-}

124+ headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

117125

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

119127 {-# INLINABLE sample #-}

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

132140 holdIncremental v0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.holdIncremental v0 e

133141 {-# INLINABLE buildDynamic #-}

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

143+ {-# INLINABLE headE #-}

144+ headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e

135145

136146--------------------------------------------------------------------------------

137147-- Deprecated items

test/Reflex/Plan/Pure.hs+1

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

4040 holdDyn initial = liftPlan . holdDyn initial

4141 holdIncremental initial = liftPlan . holdIncremental initial

4242 buildDynamic getInitial = liftPlan . buildDynamic getInitial

43+ headE = liftPlan . headE

4344

4445instance MonadSample (Pure Int) PurePlan where

4546 sample = liftPlan . sample