1780bbd · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Use cohorts instead of headE for mapIntMapWithAdjustImpl

1780bbdRyan Trinkle9 years ago

src/Reflex/Class.hs+6−1

compare with develop

unifiedsplit

@@ -101,6 +101,7 @@ module Reflex.Class

101 , zipListWithEvent

102 , numberOccurrences

103 , numberOccurrencesFrom

104+ , numberOccurrencesFrom_

104 , (<@>)

105 , (<@>)

105 , (<@)

106 , (<@)

106 , headE

107 , headE

@@ -655,7 +656,7 @@ attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b

655-- the supplied 'Event'.

656-- the supplied 'Event'.

656headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

657headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

657headE e = do

658headE e = do

658− rec be <- hold e $ fmap (const never) e'

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

659 let e' = switch be

660 let e' = switch be

660 return e'

661 return e'

661

662

@@ -1037,6 +1038,10 @@ numberOccurrences = numberOccurrencesFrom 0

1037numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))

1038numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))

1038numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))

1039numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))

1039

1040

1041+-- | Assign a number to each occurence of the given 'Event'; discard the occurrences' values

1042+numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)

1043+numberOccurrencesFrom_ = mapAccum_ (\n a -> (n + 1, n))

1044+

1040-- | This is used to sample the value of a 'Behavior' using an 'Event'.

1045-- | This is used to sample the value of a 'Behavior' using an 'Event'.

1041--

1046--

1042-- The '<@>' operator is intended to be used in conjunction with

1047-- The '<@>' operator is intended to be used in conjunction with

src/Reflex/PostBuild/Base.hs+12−12

@@ -125,9 +125,9 @@ instance (Reflex t, MonadHold t m, MonadFix m, MonadAdjust t m, PerformEvent t m

125

126{-# INLINABLE mapIntMapWithAdjustImpl #-}

127mapIntMapWithAdjustImpl :: forall t m v v' p. (Reflex t, MonadFix m, MonadHold t m, Functor p)

128− => ( (IntMap.Key -> ((Bool, Event t ()), v) -> m v')

128+ => ( (IntMap.Key -> (Event t (), v) -> m v')

129− -> IntMap ((Bool, Event t ()), v)

129+ -> IntMap (Event t (), v)

130− -> Event t (p ((Bool, Event t ()), v))

130+ -> Event t (p (Event t (), v))

131 -> m (IntMap v', Event t (p v'))

132 )

133 -> (IntMap.Key -> v -> PostBuildT t m v')

@@ -136,17 +136,17 @@ mapIntMapWithAdjustImpl :: forall t m v v' p. (Reflex t, MonadFix m, MonadHold t

136 -> PostBuildT t m (IntMap v', Event t (p v'))

137mapIntMapWithAdjustImpl base f dm0 dm' = do

138 postBuild <- getPostBuild

139− let loweredDm0 = fmap ((,) (False, postBuild)) dm0

139+ let loweredDm0 = fmap ((,) postBuild) dm0

140− f' :: IntMap.Key -> ((Bool, Event t ()), v) -> m v'

140+ f' :: IntMap.Key -> (Event t (), v) -> m v'

141− f' k ((shouldHeadE, e), v) = do

141+ f' k (e, v) = do

142− eOnce <- if shouldHeadE

143− then headE e --TODO: Avoid doing this headE so many times; once per loweredDm' firing ought to be OK, but it's not totally trivial to do because result' might be firing at the same time, and we don't want *that* to be the postBuild occurrence

144− else return e

145− runPostBuildT (f k v) eOnce

142+ runPostBuildT (f k v) e

146 lift $ do

143 lift $ do

147 rec (result0, result') <- base f' loweredDm0 loweredDm'

144 rec (result0, result') <- base f' loweredDm0 loweredDm'

148− let voidResult' = fmapCheap (\_ -> ()) result'

145+ cohortDone <- numberOccurrencesFrom_ 1 result'

149− let loweredDm' = ffor dm' $ fmap ((,) (True, voidResult'))

146+ numberedDm' <- numberOccurrencesFrom 1 dm'

147+ let postBuild' = fanInt $ fmapCheap (\n -> IntMap.singleton n ()) cohortDone

148+ loweredDm' = flip pushAlways numberedDm' $ \(n, p) -> do

149+ return $ fmap ((,) (selectInt postBuild' n)) p

150 return (result0, result')

151

152{-# INLINABLE mapDMapWithAdjustImpl #-}