git.iko.soy/reflex
on develop help sign in
Add basic NubDynamic implementation
commit73613bd49d4062c807c4517aedc7edd3e5d70ab7 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 30 May 2016, 13:52 (10 years ago) parent90cb9df
3 files changed+70−4
compare with develop
unifiedsplit
src/Reflex.hs+2 src/Reflex/Dynamic.hs+4−4 src/Reflex/Dynamic/Nub.hs+64
src/Reflex.hs+2
@@ -1,10 +1,12 @@
11module Reflex ( module Reflex.Class
22 , module Reflex.Dynamic
3+ , module Reflex.Dynamic.Nub
34 , module Reflex.Dynamic.TH
45 , module Reflex.Spider
56 ) where
67
78import Reflex.Class
89import Reflex.Dynamic
10+import Reflex.Dynamic.Nub
911import Reflex.Dynamic.TH
1012import Reflex.Spider
src/Reflex/Dynamic.hs+4−4
@@ -101,7 +101,7 @@ nubDyn d =
101101instance Reflex t => Functor (Dynamic t) where
102102 fmap f d =
103103 let e' = fmap f $ updated d
104− eb' = push (\b' -> liftM Just $ constant b') e'
104+ eb' = push (\b' -> fmap Just $ constant b') e'
105105 b0 = fmap f $ current d
106106
107107-}
@@ -124,7 +124,7 @@ foldDyn f = foldDynMaybe $ \o v -> Just $ f o v
124124-- time the 'Event' occurs using a monadic folding function on the
125125-- previous value and the value of the 'Event'.
126126foldDynM :: (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 -> liftM Just $ f o v
127+foldDynM f = foldDynMaybeM $ \o v -> fmap Just $ f o v
128128
129129foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
130130foldDynMaybe f = foldDynMaybeM $ \o v -> return $ f o v
@@ -167,7 +167,7 @@ firstE (h:t) = mergeEventsLeftBiased h =<< firstE t
167167concatEventsWith :: (Reflex t m) => (a -> a -> a) -> [Event t a] -> m (Event t a)
168168concatEventsWith _ [] = return never
169169concatEventsWith _ [e] = return e
170−concatEventsWith f es = mapEM (liftM (foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) . sequenceDmap) <=< mergeEventDMap $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
170+concatEventsWith f es = mapEM (fmap (foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) . sequenceDmap) <=< mergeEventDMap $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
171171--concatEventsWith f (h:t) = mergeEventsWith f h =<< concatEventsWith f t
172172
173173mconcatE :: (Reflex t m, Monoid a) => [Event t a] -> m (Event t a)
@@ -320,7 +320,7 @@ getDemuxed d k = return $ demuxed d k
320320demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
321321demuxed d k =
322322 let e = select (demuxSelector d) (Const2 k)
323− in unsafeBuildDynamic (liftM (==k) $ sample $ demuxValue d) e
323+ in unsafeBuildDynamic (fmap (==k) $ sample $ demuxValue d) e
324324
325325--------------------------------------------------------------------------------
326326-- collectDyn
src/Reflex/Dynamic/Nub.hsnew file+64
@@ -0,0 +1,64 @@
1+{-# LANGUAGE MagicHash #-}
2+module Reflex.Dynamic.Nub
3+ ( NubDynamic
4+ , nubDynamic
5+ , fromNubDynamic
6+ , foldNubDyn
7+ , foldNubDynM
8+ , foldNubDynMaybe
9+ , foldNubDynMaybeM
10+ ) where
11+
12+import Reflex.Class
13+import Reflex.Dynamic
14+
15+import Control.Monad.Fix
16+import GHC.Exts
17+
18+newtype NubDynamic t a = NubDynamic { unNubDynamic :: Dynamic t a }
19+
20+nubDynamic :: Reflex t => Dynamic t a -> NubDynamic t a
21+nubDynamic d = NubDynamic $ unsafeBuildDynamic (sample $ current d) $ flip push (updated d) $ \new -> do --TODO: It would be very nice if we had an uncached push here
22+ old <- sample $ current d --TODO: Is it better to sample ourselves here?
23+ return $ unsafeJustChanged old new
24+
25+fromNubDynamic :: (Reflex t, Eq a) => NubDynamic t a -> Dynamic t a
26+fromNubDynamic (NubDynamic d) = nubDyn d
27+
28+unsafeJustChanged :: a -> a -> Maybe a
29+unsafeJustChanged old new = case old `seq` new `seq` reallyUnsafePtrEquality# old new of
30+ 0# -> Just new
31+ _ -> Nothing
32+
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
51+
52+instance Reflex t => Functor (NubDynamic t) where
53+ fmap f (NubDynamic d) = nubDynamic $ fmap f d
54+
55+instance Reflex t => Applicative (NubDynamic t) where
56+ pure = NubDynamic . constDyn
57+ NubDynamic a <*> NubDynamic b = nubDynamic $ a <*> b
58+ _ *> b = b
59+ a <* _ = a
60+
61+instance Reflex t => Monad (NubDynamic t) where
62+ NubDynamic x >>= f = nubDynamic $ x >>= unNubDynamic . f
63+ _ >> b = b
64+ return = pure