168b4cd · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Actually use the new headE

168b4cdRyan Trinkle9 years ago

src/Reflex/Class.hs+11−5

compare with develop

unifiedsplit

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

136 , tagCheap

137 , mergeWithCheap

138 , mergeWithCheap'

139+ -- * Slow, but general, implementations

140+ , slowHeadE

139#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

141#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

140 , Spider

142 , Spider

141 , SpiderEnv

143 , SpiderEnv

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

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

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

457 holdIncremental v0 = lift . holdIncremental v0

459 holdIncremental v0 = lift . holdIncremental v0

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

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

461+ {-

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

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

460 buildDynamic getV0 = lift . buildDynamic getV0

463 buildDynamic getV0 = lift . buildDynamic getV0

464+ -}

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

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

462 -- the supplied 'Event'.

466 -- the supplied 'Event'.

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

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

468+

469+

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

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

465− headE e = do

471+slowHeadE e = do

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

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

467− let e' = switch be

473+ let e' = switch be

468− return e'

474+ return e'

469

475

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

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

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

477-- 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

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

160 {-# INLINABLE buildDynamic #-}

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

162+ {-# INLINABLE headE #-}

163+ headE = PerformEventT . lift . headE

162

164

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

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

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

166 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

202 in case unEvent e lastTime of

203 Nothing -> lastValue

204 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

18 holdIncremental = holdIncrementalSpiderEventM

19 {-# INLINABLE buildDynamic #-}

20 buildDynamic = buildDynamicSpiderEventM

21+ {-# INLINABLE headE #-}

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

22instance (

24instance (

23#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

25#ifdef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

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

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

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

47 {-# INLINABLE buildDynamic #-}

49 {-# INLINABLE buildDynamic #-}

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

50 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

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

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

51 {-# INLINE return #-}

55 {-# INLINE return #-}

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

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

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

102 {-# INLINABLE buildDynamic #-}

106 {-# INLINABLE buildDynamic #-}

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

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

108+ {-# INLINABLE headE #-}

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

104

110

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

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

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

112 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

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

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

115 {-# INLINABLE buildDynamic #-}

121 {-# INLINABLE buildDynamic #-}

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

122 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

117

125

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

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

119 {-# INLINABLE sample #-}

127 {-# INLINABLE sample #-}

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

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

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

133 {-# INLINABLE buildDynamic #-}

141 {-# INLINABLE buildDynamic #-}

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

142 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

135

145

136--------------------------------------------------------------------------------

146--------------------------------------------------------------------------------

137-- Deprecated items

147-- Deprecated items

test/Reflex/Plan/Pure.hs+1

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

40 holdDyn initial = liftPlan . holdDyn initial

41 holdIncremental initial = liftPlan . holdIncremental initial

42 buildDynamic getInitial = liftPlan . buildDynamic getInitial

43+ headE = liftPlan . headE

44instance MonadSample (Pure Int) PurePlan where

45instance MonadSample (Pure Int) PurePlan where

45 sample = liftPlan . sample

46 sample = liftPlan . sample