1780bbd · patch · git.iko.soy

git.iko.soy/patch

Use cohorts instead of headE for mapIntMapWithAdjustImpl

commit1780bbd86cb3972f603e97081f1494b4e37d1f53 authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 24 Aug 2017, 11:34 (9 years ago) parentae399d1

2 files changed+18−13

compare with develop

unifiedsplit

src/Reflex/Class.hs+6−1 src/Reflex/PostBuild/Base.hs+12−12

src/Reflex/Class.hs+6−1

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

101101 , zipListWithEvent

102102 , numberOccurrences

103103 , numberOccurrencesFrom

104+ , numberOccurrencesFrom_

104105 , (<@>)

105106 , (<@)

106107 , headE

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

655656-- the supplied 'Event'.

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

657658headE e = do

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

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

659660 let e' = switch be

660661 return e'

661662

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

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

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

10391040

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+

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

10411046--

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

125125

126126{-# INLINABLE mapIntMapWithAdjustImpl #-}

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

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

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

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

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

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

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

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

132132 )

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

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

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

137137mapIntMapWithAdjustImpl base f dm0 dm' = do

138138 postBuild <- getPostBuild

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

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

141− f' k ((shouldHeadE, 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

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

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

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

142+ runPostBuildT (f k v) e

146143 lift $ do

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

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

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

145+ cohortDone <- numberOccurrencesFrom_ 1 result'

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

150150 return (result0, result')

151151

152152{-# INLINABLE mapDMapWithAdjustImpl #-}