@@ -3,6 +3,7 @@
33{-# LANGUAGE FlexibleContexts #-}
44{-# LANGUAGE FlexibleInstances #-}
55{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
67{-# LANGUAGE MultiParamTypeClasses #-}
78{-# LANGUAGE RankNTypes #-}
89{-# LANGUAGE RecursiveDo #-}
@@ -23,6 +24,24 @@ import Data.Monoid
2324
2425import Prelude
2526
27+pushDyn :: (Reflex t, MonadHold t m) => (a -> PushM t b) -> Dynamic t a -> m (Dynamic t b)
28+pushDyn f d = buildDynamic (sample (current d) >>= f) (pushAlways f (updated d))
29+
30+foldedDyn :: (Reflex t, MonadHold t m) => (a -> a -> a) -> Dynamic t a -> m (Dynamic t a)
31+foldedDyn f d = fmap join $ flip buildDynamic never $ do
32+ a <- sample (current d)
33+ foldDyn f a (updated d)
34+
35+scannedDyn :: (Reflex t, MonadHold t m) => Dynamic t a -> m (Dynamic t [a])
36+scannedDyn = fmap (fmap reverse) . foldedDyn (<>) . fmap pure
37+
38+scanInnerDyns :: (Reflex t, MonadHold t m) => Dynamic t (Dynamic t a) -> m (Dynamic t [a])
39+scanInnerDyns d = do
40+ scans <- scannedDyn d
41+ return (join (fmap distributeListOverDynPure scans))
42+
43+
44+
2645{-# ANN testCases "HLint: ignore Functor law" #-}
2746testCases :: [(String, TestCase)]
2847testCases =
@@ -201,6 +220,14 @@ testCases =
201220 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
202221 return $ pull $ sample =<< sample bb
203222
223+
224+ , testB "foldDynWhileFiring" $ do
225+ e <- events1
226+ d <- foldDyn (:) [] $
227+ pushAlways (\a -> foldDyn (:) [a] e) e
228+
229+ return $ current (join (fmap distributeListOverDynPure d))
230+
204231 , testE "joinDyn" $ do
205232 e <- events1
206233 bb <- hold "b" e
@@ -223,6 +250,38 @@ testCases =
223250 d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2
224251
225252 return $ current $ zipDynWith (<>) d1 d2
253+
254+ , testB "buildDynamicStrictness" $ do
255+ rec
256+ d'' <- pushDyn return d'
257+ d' <- pushDyn return d
258+ d <- holdDyn "0" =<< events1
259+
260+ _ <- sample (current d'')
261+ return (current d'')
262+
263+ , testB "factorDyn" $ do
264+ d <- holdDyn (Left "a") =<< eithers
265+
266+ eithers <- eitherDyn d
267+ let unFactor = either id id
268+ return $ current (join (fmap unFactor eithers))
269+
270+ , testB "pushDynDeep" $ do
271+ e1 <- events1
272+ e2 <- events2
273+
274+ d1 <- holdDyn "d1" =<< events1
275+ d2 <- holdDyn "d2" =<< events2
276+
277+ d <- flip pushDyn d1 $ \a ->
278+ flip pushDyn d2 $ \b ->
279+ flip pushDyn d1 $ \c ->
280+ return (a <> b <> c)
281+
282+ d' <- pushDyn scanInnerDyns d >>= scanInnerDyns
283+ return $ current d'
284+
226285 , testE "fan-1" $ do
227286 e <- fmap toMap <$> events1
228287 let es = select (fanMap e) . Const2 <$> values
@@ -264,14 +323,18 @@ testCases =
264323 return $ void e
265324 lazyHold
266325
326+
267327 ] where
268328
269329 events1, events2, events3 :: TestPlan t m => m (Event t String)
270330 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
271331 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
272−
273332 events3 = liftA2 mappend events1 events2
274333
334+ eithers :: TestPlan t m => m (Event t (Either String String))
335+ eithers = plan [(1, Left "e"), (3, Left "d"), (4, Right "c"), (6, Right "b"), (7, Left "a")]
336+
337+
275338 values = "abcde"
276339 toMap str = Map.fromList $ map (\c -> (c, c)) str
277340
@@ -281,5 +344,3 @@ testCases =
281344
282345 deep e = leftmost [e, e]
283346 leftmost2 e1 e2 = leftmost [e1, e2]
284−
285−