@@ -23,6 +23,10 @@ import Data.Functor.Misc
2323import qualified Data.Map as Map
2424import Data.Map (Map)
2525
26+import qualified Data.IntMap as IntMap
27+import Data.IntMap (IntMap)
28+
29+
2630import Data.These
2731import Data.Align
2832
@@ -41,6 +45,7 @@ import Data.These.Lens
4145
4246type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
4347
48+
4449connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
4550connectDyn e (d, d') = do
4651 dd <- holdDyn d (d' <$ e)
@@ -78,7 +83,7 @@ addHeight e = leftmost [e4, e4] where
7883 e4 = leftmost [e3, e3]
7984
8085
81−-- Take an existing test and build it inside a push
86+-- Take an existing test and build it inside a
8287buildLoop :: Widget t m => (forall t m. Widget t m => (Event t Int, Event t ()) -> m (Event t Int)) -> (Event t Int, Event t ()) -> m (Event t Int)
8388buildLoop test (e1, e2) = switchHold never buildLoop
8489 where buildLoop = pushAlways (const $ test (e1, e2)) e2
@@ -99,9 +104,25 @@ switchLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
99104switchLoop (e1, e2) = do
100105 rec
101106 e' <- connectButton e2 (updated d)
102− d <- count (align e' (addHeight e1))
107+ d <- count (align e' e1)
103108 return $ updated d
104109
110+mergeLoop :: forall t m. (Adjustable t m, Widget t m) => (Event t Int, Event t ()) -> m (Event t Int)
111+mergeLoop (e1, e2) = do
112+ rec
113+ (_, e) <- runEventWriterT $
114+ runWithReplace w (leftmost [w <$ e1])
115+
116+ return (sum <$> e)
117+
118+ where
119+ w = do
120+ c <- count e1
121+ tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
122+
123+
124+
125+
105126switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
106127switchLoop' (e1, e2) = do
107128 rec
@@ -152,20 +173,25 @@ runTest (name, TestCase test) = do
152173
153174 where
154175
155− run = runApp' (test . splitThese) (Just <$> occs)
156− >> error (name <> ": unexpected success")
176+ run = do
177+ r <- runApp' (test . splitThese) (Just <$> occs)
178+ error (name <> ": unexpected success " <> show r)
157179
158− occs = [ That (), This 3, That (), This 4 ]
180+ occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
159181
160182 milliseconds = (*1000)
161183
162184
163−newtype TestCase = TestCase { unTest :: forall t m. Widget t m => (Event t Int, Event t ()) -> m (Event t Int) }
185+newtype TestCase = TestCase { unTest :: forall t m. (Widget t m, Adjustable t m) => (Event t Int, Event t ()) -> m (Event t Int) }
164186
165187tests :: [(String, TestCase)]
166188tests =
167189 [ ("switchLoop'", TestCase switchLoop')
168− --, ("switchLoop", TestCase switchLoop)
190+ , ("switchLoop", TestCase switchLoop)
191+
192+ , ("mergeLoop", TestCase mergeLoop)
193+
194+
169195 -- , ("switchLoop2", TestCase switchLoop2)
170196
171197 -- , ("staticLoop'", TestCase staticLoop')