git.iko.soy/reflex
on develop help sign in
WIP
cdf637cOliver Batchelor
src/Reflex/Spider/Internal.hs+6−1
compare with develop
unifiedsplit
@@ -1298,7 +1298,6 @@ type CanTrace x m = (HasSpiderTimeline x, MonadIO m)
1298debugSubscriber :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> IO (Subscriber x a)
1298debugSubscriber :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> IO (Subscriber x a)
1299debugSubscriber description = return . debugSubscriber' description
1299debugSubscriber description = return . debugSubscriber' description
1300
1300
1301−
1302debugSubscriber' :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> Subscriber x a
1301debugSubscriber' :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> Subscriber x a
1303debugSubscriber' description subscribed = Subscriber
1302debugSubscriber' description subscribed = Subscriber
1304 {
1303 {
@@ -1361,6 +1360,12 @@ traceInvalidate _ = return ()
1361debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)
1360debugSubscriber :: String -> Subscriber x a -> IO (Subscriber x a)
1362debugSubscriber _ = return
1361debugSubscriber _ = return
1363
1362
1363+{-# INLINE debugSubscriber' #-}
1364+debugSubscriber' :: String -> Subscriber x a -> Subscriber x a
1365+debugSubscriber' _ = id
1366+
1367+
1368+
1364{-# INLINE trace #-}
1369{-# INLINE trace #-}
1365trace :: (CanTrace x m) => proxy x -> String -> m ()
1370trace :: (CanTrace x m) => proxy x -> String -> m ()
1366trace _ _ = return ()
1371trace _ _ = return ()
test/DebugCycles.hs+33−7
@@ -23,6 +23,10 @@ import Data.Functor.Misc
23import qualified Data.Map as Map
23import qualified Data.Map as Map
24import Data.Map (Map)
24import Data.Map (Map)
25
25
26+import qualified Data.IntMap as IntMap
27+import Data.IntMap (IntMap)
28+
29+
26import Data.These
30import Data.These
27import Data.Align
31import Data.Align
28
32
@@ -41,6 +45,7 @@ import Data.These.Lens
41
45
42type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
46type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
43
47
48+
44connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
49connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
45connectDyn e (d, d') = do
50connectDyn e (d, d') = do
46 dd <- holdDyn d (d' <$ e)
51 dd <- holdDyn d (d' <$ e)
@@ -78,7 +83,7 @@ addHeight e = leftmost [e4, e4] where
78 e4 = leftmost [e3, e3]
83 e4 = leftmost [e3, e3]
79
84
80
85
81−-- Take an existing test and build it inside a push
86+-- Take an existing test and build it inside a
82buildLoop :: 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)
87buildLoop :: 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)
83buildLoop test (e1, e2) = switchHold never buildLoop
88buildLoop test (e1, e2) = switchHold never buildLoop
84 where buildLoop = pushAlways (const $ test (e1, e2)) e2
89 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)
99switchLoop (e1, e2) = do
104switchLoop (e1, e2) = do
100 rec
105 rec
101 e' <- connectButton e2 (updated d)
106 e' <- connectButton e2 (updated d)
102− d <- count (align e' (addHeight e1))
107+ d <- count (align e' e1)
103 return $ updated d
108 return $ updated d
104
109
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+
105switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
126switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
106switchLoop' (e1, e2) = do
127switchLoop' (e1, e2) = do
107 rec
128 rec
@@ -152,20 +173,25 @@ runTest (name, TestCase test) = do
152
173
153 where
174 where
154
175
176+ run = do
155− run = runApp' (test . splitThese) (Just <$> occs)
177+ r <- runApp' (test . splitThese) (Just <$> occs)
156− >> error (name <> ": unexpected success")
178+ error (name <> ": unexpected success " <> show r)
157
179
158− occs = [ That (), This 3, That (), This 4 ]
180+ occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
159
181
160 milliseconds = (*1000)
182 milliseconds = (*1000)
161
183
162
184
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) }
164
186
165tests :: [(String, TestCase)]
187tests :: [(String, TestCase)]
166tests =
188tests =
167 [ ("switchLoop'", TestCase switchLoop')
189 [ ("switchLoop'", TestCase switchLoop')
168− --, ("switchLoop", TestCase switchLoop)
190+ , ("switchLoop", TestCase switchLoop)
191+
192+ , ("mergeLoop", TestCase mergeLoop)
193+
194+
169 -- , ("switchLoop2", TestCase switchLoop2)
195 -- , ("switchLoop2", TestCase switchLoop2)
170
196
171 -- , ("staticLoop'", TestCase staticLoop')
197 -- , ("staticLoop'", TestCase staticLoop')