c8b65a4 · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Add Reflex.Dynamic.Nub

c8b65a4Ryan Trinkle10 years ago

src/Reflex/Class.hs+72−15

compare with develop

unifiedsplit

@@ -25,6 +25,7 @@ import Data.Functor.Compose

25import Data.Functor.Constant

26import Data.Foldable

27import Data.Maybe

28+import Data.Bifunctor

29-- Note: must come last to silence warnings due to AMP on GHC < 7.10

30-- Note: must come last to silence warnings due to AMP on GHC < 7.10

30import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)

31import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)

@@ -254,21 +255,6 @@ instance Reflex t => FunctorMaybe (Event t) where

254instance Reflex t => Functor (Event t) where

255instance Reflex t => Functor (Event t) where

255 fmap f = fmapMaybe $ Just . f

256 fmap f = fmapMaybe $ Just . f

256

257

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−

272-- | Replace each occurrence value of the 'Event' with the value of the

258-- | Replace each occurrence value of the 'Event' with the value of the

273-- 'Behavior' at the time of that occurrence.

259-- 'Behavior' at the time of that occurrence.

274tag :: Reflex t => Behavior t b -> Event t a -> Event t b

260tag :: Reflex t => Behavior t b -> Event t a -> Event t b

@@ -501,3 +487,74 @@ distributeDMapOverDynPure dm = case DMap.toList dm of

501 olds <- sample $ current result

487 olds <- sample $ current result

502 return $ DMap.unionWithKey (\_ _ new -> new) olds news

488 return $ DMap.unionWithKey (\_ _ new -> new) olds news

503 in result

489 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 =

97 let e' = attachWithMaybe (\x x' -> if x' == x then Nothing else Just x') (current d) (updated d)

98 in unsafeDynamic (current d) e' --TODO: Avoid invalidating the outgoing Behavior

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−

109-- | Map a function over a 'Dynamic'.

100-- | Map a function over a 'Dynamic'.

110mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)

101mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)

111mapDyn f = return . fmap f

102mapDyn f = return . fmap f

@@ -118,24 +109,19 @@ forDyn = flip mapDyn

118-- time the 'Event' occurs using a folding function on the previous

109-- time the 'Event' occurs using a folding function on the previous

119-- value and the value of the 'Event'.

110-- value and the value of the 'Event'.

120foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)

111foldDyn :: (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

122

113

123-- | Create a 'Dynamic' using the initial value and change it each

114-- | Create a 'Dynamic' using the initial value and change it each

124-- time the 'Event' occurs using a monadic folding function on the

115-- time the 'Event' occurs using a monadic folding function on the

125-- previous value and the value of the 'Event'.

116-- previous value and the value of the 'Event'.

126foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)

117foldDynM :: (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

128

119

129foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)

120foldDynMaybe :: (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

131

122

132foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)

123foldDynMaybeM :: (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

124+foldDynMaybeM = accumMaybeM . flip

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'

139

125

140-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.

126-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.

141count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)

127count :: (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 #-}

2module Reflex.Dynamic.Nub

3 ( NubDynamic

4 , nubDynamic

5 , fromNubDynamic

6− , foldNubDyn

6+ , alreadyNubbedDynamic

7− , foldNubDynM

8− , foldNubDynMaybe

9− , foldNubDynMaybeM

10 ) where

7 ) where

12import Reflex.Class

9import Reflex.Class

13import Reflex.Dynamic

10import Reflex.Dynamic

15−import Control.Monad.Fix

16import GHC.Exts

12import GHC.Exts

18newtype NubDynamic t a = NubDynamic { unNubDynamic :: Dynamic t a }

14newtype NubDynamic t a = NubDynamic { unNubDynamic :: Dynamic t a }

@@ -25,29 +21,29 @@ nubDynamic d = NubDynamic $ unsafeBuildDynamic (sample $ current d) $ flip push

25fromNubDynamic :: (Reflex t, Eq a) => NubDynamic t a -> Dynamic t a

21fromNubDynamic :: (Reflex t, Eq a) => NubDynamic t a -> Dynamic t a

26fromNubDynamic (NubDynamic d) = nubDyn d

22fromNubDynamic (NubDynamic d) = nubDyn d

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+

28unsafeJustChanged :: a -> a -> Maybe a

29unsafeJustChanged :: a -> a -> Maybe a

29unsafeJustChanged old new = case old `seq` new `seq` reallyUnsafePtrEquality# old new of

30unsafeJustChanged old new = case old `seq` new `seq` reallyUnsafePtrEquality# old new of

30 0# -> Just new

31 0# -> Just new

31 _ -> Nothing

32 _ -> Nothing

33−foldNubDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (NubDynamic t b)

34+instance Reflex t => Accumulator t (NubDynamic t) where

34−foldNubDyn f = foldNubDynMaybe $ \o v -> Just $ f o v

35+ accumMaybeM f z e = do

35−

36+ let f' old change = do

36−foldNubDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (NubDynamic t b)

37+ mNew <- f old change

37−foldNubDynM f = foldNubDynMaybeM $ \o v -> fmap Just $ f o v

38+ return $ unsafeJustChanged old =<< mNew

38−

39+ d <- accumMaybeM f' z e

39−foldNubDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (NubDynamic t b)

40+ return $ NubDynamic d

40−foldNubDynMaybe f = foldNubDynMaybeM $ \o v -> return $ f o v

41+ mapAccumMaybeM f z e = do

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

42+ let f' old change = do

45− x <- f change old

43+ (mNew, output) <- f old change

46− return $ case x of

47− Nothing -> Nothing

48− Just new -> unsafeJustChanged old new

44+ return (unsafeJustChanged old =<< mNew, output)

49− d <- foldDynMaybeM f' z e

45+ (d, out) <- mapAccumMaybeM f' z e

50− return $ NubDynamic d

46+ return (NubDynamic d, out)

52instance Reflex t => Functor (NubDynamic t) where

48instance Reflex t => Functor (NubDynamic t) where

53 fmap f (NubDynamic d) = nubDynamic $ fmap f d

49 fmap f (NubDynamic d) = nubDynamic $ fmap f d