git.iko.soy/patch
on develop help sign in
Add Reflex.Dynamic.Nub
commitc8b65a40f7446962953d36171d2c7b8f15612904 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 30 May 2016, 15:39 (10 years ago) parent73613bd
3 files changed+96−57
compare with develop
unifiedsplit
src/Reflex/Class.hs+72−15 src/Reflex/Dynamic.hs+4−18 src/Reflex/Dynamic/Nub.hs+20−24
src/Reflex/Class.hs+72−15
@@ -25,6 +25,7 @@ import Data.Functor.Compose
2525import Data.Functor.Constant
2626import Data.Foldable
2727import Data.Maybe
28+import Data.Bifunctor
2829
2930-- Note: must come last to silence warnings due to AMP on GHC < 7.10
3031import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
@@ -254,21 +255,6 @@ instance Reflex t => FunctorMaybe (Event t) where
254255instance Reflex t => Functor (Event t) where
255256 fmap f = fmapMaybe $ Just . f
256257
257−-- | Create a new 'Event' by combining each occurence with the next value
258−-- of the list using the supplied function. If the list runs out of items,
259−-- all subsequent 'Event' occurrences will be ignored.
260−zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
261−zipListWithEvent f l e = do
262− rec lb <- hold l eTail
263− let eBoth = flip push e $ \o -> do
264− l' <- sample lb
265− return $ case l' of
266− (h : t) -> Just (f h o, t)
267− [] -> Nothing
268− let eTail = fmap snd eBoth
269− lb `seq` eBoth `seq` eTail `seq` return ()
270− return $ fmap fst eBoth
271−
272258-- | Replace each occurrence value of the 'Event' with the value of the
273259-- 'Behavior' at the time of that occurrence.
274260tag :: Reflex t => Behavior t b -> Event t a -> Event t b
@@ -501,3 +487,74 @@ distributeDMapOverDynPure dm = case DMap.toList dm of
501487 olds <- sample $ current result
502488 return $ DMap.unionWithKey (\_ _ new -> new) olds news
503489 in result
490+
491+class Reflex t => Accumulator t f | f -> t where
492+ accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
493+ accum f = accumMaybe $ \v o -> Just $ f v o
494+ accumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (f a)
495+ accumM f = accumMaybeM $ \v o -> Just <$> f v o
496+ accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
497+ accumMaybe f = accumMaybeM $ \v o -> return $ f v o
498+ accumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (f a)
499+ mapAccum :: (MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (f a, Event t c)
500+ mapAccum f = mapAccumMaybe $ \v o -> bimap Just Just $ f v o
501+ mapAccumM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (f a, Event t c)
502+ mapAccumM f = mapAccumMaybeM $ \v o -> bimap Just Just <$> f v o
503+ mapAccumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
504+ mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
505+ mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
506+
507+mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
508+mapAccum_ f z e = do
509+ (_ :: Behavior t a, result) <- mapAccum f z e
510+ return result
511+
512+mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
513+mapAccumMaybe_ f z e = do
514+ (_ :: Behavior t a, result) <- mapAccumMaybe f z e
515+ return result
516+
517+mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
518+mapAccumM_ f z e = do
519+ (_ :: Behavior t a, result) <- mapAccumM f z e
520+ return result
521+
522+mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
523+mapAccumMaybeM_ f z e = do
524+ (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
525+ return result
526+
527+instance Reflex t => Accumulator t (Dynamic t) where
528+ accumMaybeM f z e = do
529+ rec let e' = flip push e $ \o -> do
530+ v <- sample $ current d'
531+ f v o
532+ d' <- holdDyn z e'
533+ return d'
534+ mapAccumMaybeM f z e = do
535+ rec let e' = flip push e $ \o -> do
536+ v <- sample $ current d'
537+ result <- f v o
538+ return $ case result of
539+ (Nothing, Nothing) -> Nothing
540+ _ -> Just result
541+ d' <- holdDyn z $ fmapMaybe fst e'
542+ return (d', fmapMaybe snd e')
543+
544+instance Reflex t => Accumulator t (Behavior t) where
545+ accumMaybeM f z e = current <$> accumMaybeM f z e
546+ mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e
547+
548+instance Reflex t => Accumulator t (Event t) where
549+ accumMaybeM f z e = updated <$> accumMaybeM f z e
550+ mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
551+
552+-- | Create a new 'Event' by combining each occurence with the next value
553+-- of the list using the supplied function. If the list runs out of items,
554+-- all subsequent 'Event' occurrences will be ignored.
555+zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
556+zipListWithEvent f l e = do
557+ let f' a b = case a of
558+ h:t -> (Just t, Just $ f h b)
559+ _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
560+ mapAccumMaybe_ f' l e
src/Reflex/Dynamic.hs+4−18
@@ -97,15 +97,6 @@ nubDyn d =
9797 let e' = attachWithMaybe (\x x' -> if x' == x then Nothing else Just x') (current d) (updated d)
9898 in unsafeDynamic (current d) e' --TODO: Avoid invalidating the outgoing Behavior
9999
100−{-
101−instance Reflex t => Functor (Dynamic t) where
102− fmap f d =
103− let e' = fmap f $ updated d
104− eb' = push (\b' -> fmap Just $ constant b') e'
105− b0 = fmap f $ current d
106−
107−-}
108−
109100-- | Map a function over a 'Dynamic'.
110101mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
111102mapDyn f = return . fmap f
@@ -118,24 +109,19 @@ forDyn = flip mapDyn
118109-- time the 'Event' occurs using a folding function on the previous
119110-- value and the value of the 'Event'.
120111foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
121−foldDyn f = foldDynMaybe $ \o v -> Just $ f o v
112+foldDyn = accum . flip
122113
123114-- | Create a 'Dynamic' using the initial value and change it each
124115-- time the 'Event' occurs using a monadic folding function on the
125116-- previous value and the value of the 'Event'.
126117foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
127−foldDynM f = foldDynMaybeM $ \o v -> fmap Just $ f o v
118+foldDynM = accumM . flip
128119
129120foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
130−foldDynMaybe f = foldDynMaybeM $ \o v -> return $ f o v
121+foldDynMaybe = accumMaybe . flip
131122
132123foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
133−foldDynMaybeM f z e = do
134− rec let e' = flip push e $ \o -> do
135− v <- sample $ current d'
136− f o v
137− d' <- holdDyn z e'
138− return d'
124+foldDynMaybeM = accumMaybeM . flip
139125
140126-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.
141127count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
src/Reflex/Dynamic/Nub.hs+20−24
@@ -1,18 +1,14 @@
1−{-# LANGUAGE MagicHash #-}
1+{-# LANGUAGE MagicHash, FlexibleInstances, MultiParamTypeClasses #-}
22module Reflex.Dynamic.Nub
33 ( NubDynamic
44 , nubDynamic
55 , fromNubDynamic
6− , foldNubDyn
7− , foldNubDynM
8− , foldNubDynMaybe
9− , foldNubDynMaybeM
6+ , alreadyNubbedDynamic
107 ) where
118
129import Reflex.Class
1310import Reflex.Dynamic
1411
15−import Control.Monad.Fix
1612import GHC.Exts
1713
1814newtype NubDynamic t a = NubDynamic { unNubDynamic :: Dynamic t a }
@@ -25,29 +21,29 @@ nubDynamic d = NubDynamic $ unsafeBuildDynamic (sample $ current d) $ flip push
2521fromNubDynamic :: (Reflex t, Eq a) => NubDynamic t a -> Dynamic t a
2622fromNubDynamic (NubDynamic d) = nubDyn d
2723
24+-- | Create a NubDynamic without nubbing it on creation
25+-- This will be slightly faster than nubDynamic when used with a Dynamic whose values are always (or nearly always) different from its previous values; if used with a Dynamic whose values do not change frequently, it may be much slower than nubDynamic
26+alreadyNubbedDynamic :: Dynamic t a -> NubDynamic t a
27+alreadyNubbedDynamic = NubDynamic
28+
2829unsafeJustChanged :: a -> a -> Maybe a
2930unsafeJustChanged old new = case old `seq` new `seq` reallyUnsafePtrEquality# old new of
3031 0# -> Just new
3132 _ -> Nothing
3233
33−foldNubDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (NubDynamic t b)
34−foldNubDyn f = foldNubDynMaybe $ \o v -> Just $ f o v
35−
36−foldNubDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (NubDynamic t b)
37−foldNubDynM f = foldNubDynMaybeM $ \o v -> fmap Just $ f o v
38−
39−foldNubDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (NubDynamic t b)
40−foldNubDynMaybe f = foldNubDynMaybeM $ \o v -> return $ f o v
41−
42−foldNubDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (NubDynamic t b)
43−foldNubDynMaybeM f z e = do
44− let f' change old = do
45− x <- f change old
46− return $ case x of
47− Nothing -> Nothing
48− Just new -> unsafeJustChanged old new
49− d <- foldDynMaybeM f' z e
50− return $ NubDynamic d
34+instance Reflex t => Accumulator t (NubDynamic t) where
35+ accumMaybeM f z e = do
36+ let f' old change = do
37+ mNew <- f old change
38+ return $ unsafeJustChanged old =<< mNew
39+ d <- accumMaybeM f' z e
40+ return $ NubDynamic d
41+ mapAccumMaybeM f z e = do
42+ let f' old change = do
43+ (mNew, output) <- f old change
44+ return (unsafeJustChanged old =<< mNew, output)
45+ (d, out) <- mapAccumMaybeM f' z e
46+ return (NubDynamic d, out)
5147
5248instance Reflex t => Functor (NubDynamic t) where
5349 fmap f (NubDynamic d) = nubDynamic $ fmap f d