on develop help sign in
Increase and clean up laziness in Reflex.Dynamic
8a2055aRyan Trinkle
src/Reflex/Dynamic.hs+14−12
@@ -125,10 +125,10 @@ forDyn = flip mapDyn
125
125
126{-# INLINE mapDynM #-}
126{-# INLINE mapDynM #-}
127mapDynM :: forall t m a b. (Reflex t, MonadHold t m) => (forall m'. MonadSample t m' => a -> m' b) -> Dynamic t a -> m (Dynamic t b)
127mapDynM :: forall t m a b. (Reflex t, MonadHold t m) => (forall m'. MonadSample t m' => a -> m' b) -> Dynamic t a -> m (Dynamic t b)
128−mapDynM f (~(Dynamic b e)) = do
128+mapDynM f d = do
129− let e' = push (liftM Just . f :: a -> PushM t (Maybe b)) e
129+ let e' = push (liftM Just . f :: a -> PushM t (Maybe b)) $ updated d
130 eb' = fmap constant e'
130 eb' = fmap constant e'
131− v0 = pull $ f =<< sample b
131+ v0 = pull $ f =<< sample (current d)
132 bb' :: Behavior t (Behavior t b) <- hold v0 eb'
132 bb' :: Behavior t (Behavior t b) <- hold v0 eb'
133 let b' = pull $ sample =<< sample bb'
133 let b' = pull $ sample =<< sample bb'
134 return $ Dynamic b' e'
134 return $ Dynamic b' e'
@@ -203,19 +203,19 @@ distributeDMapOverDyn dm = case DMap.toList dm of
203 return $ Dynamic bdm edm
203 return $ Dynamic bdm edm
204
204
205combineDyn :: forall t m a b c. (Reflex t, MonadHold t m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
205combineDyn :: forall t m a b c. (Reflex t, MonadHold t m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
206−combineDyn f (~(Dynamic ba ea)) (~(Dynamic bb eb)) = do
206+combineDyn f da db = do
207− let eab = align ea eb
207+ let eab = align (updated da) (updated db)
208 ec = flip push eab $ \o -> do
208 ec = flip push eab $ \o -> do
209 (a, b) <- case o of
209 (a, b) <- case o of
210 This a -> do
210 This a -> do
211− b <- sample bb
211+ b <- sample $ current db
212 return (a, b)
212 return (a, b)
213 That b -> do
213 That b -> do
214− a <- sample ba
214+ a <- sample $ current da
215 return (a, b)
215 return (a, b)
216 These a b -> return (a, b)
216 These a b -> return (a, b)
217 return $ Just $ f a b
217 return $ Just $ f a b
218− c0 :: Behavior t c = pull $ liftM2 f (sample ba) (sample bb)
218+ c0 :: Behavior t c = pull $ liftM2 f (sample $ current da) (sample $ current db)
219 bbc :: Behavior t (Behavior t c) <- hold c0 $ fmap constant ec
219 bbc :: Behavior t (Behavior t c) <- hold c0 $ fmap constant ec
220 let bc :: Behavior t c = pull $ sample =<< sample bbc
220 let bc :: Behavior t c = pull $ sample =<< sample bbc
221 return $ Dynamic bc ec
221 return $ Dynamic bc ec
@@ -281,16 +281,18 @@ attachDynWithMaybe f d e =
281-- Demux
281-- Demux
282--------------------------------------------------------------------------------
282--------------------------------------------------------------------------------
283
283
284−data Demux t k = Demux (Behavior t k) (EventSelector t (Const2 k Bool))
284+data Demux t k = Demux { demuxValue :: Behavior t k
285+ , demuxSelector :: EventSelector t (Const2 k Bool)
286+ }
285
287
286demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
288demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
287demux k = Demux (current k) (fan $ attachWith (\k0 k1 -> if k0 == k1 then DMap.empty else DMap.fromList [Const2 k0 :=> False, Const2 k1 :=> True]) (current k) (updated k))
289demux k = Demux (current k) (fan $ attachWith (\k0 k1 -> if k0 == k1 then DMap.empty else DMap.fromList [Const2 k0 :=> False, Const2 k1 :=> True]) (current k) (updated k))
288
290
289--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
291--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
290getDemuxed :: (Reflex t, MonadHold t m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
292getDemuxed :: (Reflex t, MonadHold t m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
291−getDemuxed (Demux bk es) k = do
293+getDemuxed d k = do
292− let e = select es (Const2 k)
294+ let e = select (demuxSelector d) (Const2 k)
293− bb <- hold (liftM (==k) $ sample bk) $ fmap return e
295+ bb <- hold (liftM (==k) $ sample $ demuxValue d) $ fmap return e
294 let b = pull $ join $ sample bb
296 let b = pull $ join $ sample bb
295 return $ Dynamic b e
297 return $ Dynamic b e
296
298