@@ -15,28 +15,19 @@ import Control.Applicative
1515import Control.Monad
1616import Control.Monad.Fix
1717import Control.Exception
18−
1918import System.Timeout
20−
2119import Data.Maybe (isJust)
2220import Data.Functor.Misc
2321import qualified Data.Map as Map
2422import Data.Map (Map)
25−
2623import qualified Data.IntMap as IntMap
2724import Data.IntMap (IntMap)
28−
29−
3025import Data.These
3126import Data.Align
32−
3327import Reflex
3428import Reflex.EventWriter.Base
3529import Test.Run
36−
3730import Reflex.Spider.Internal (EventLoopException)
38−
39−
4031import Data.Witherable (Filterable)
4132
4233#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
@@ -45,13 +36,11 @@ import Data.These.Lens
4536
4637type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
4738
48−
4939connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
5040connectDyn e (d, d') = do
5141 dd <- holdDyn d (d' <$ e)
5242 return $ join dd
5343
54−
5544dynLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
5645dynLoop (e1, e2) = do
5746 -- "heightBagRemove: Height 2 not present in bag HeightBag {_heightBag_size = 2, _heightBag_contents = fromList [(0,1)]}"
@@ -74,7 +63,6 @@ coincidenceLoop (e1, e2) = do
7463 d <- count (align e' e1)
7564 return $ updated d
7665
77−
7866addHeight :: Reflex t => Event t a -> Event t a
7967addHeight e = leftmost [e4, e4] where
8068 e1 = leftmost [e, e]
@@ -82,13 +70,11 @@ addHeight e = leftmost [e4, e4] where
8270 e3 = leftmost [e2, e2]
8371 e4 = leftmost [e3, e3]
8472
85−
8673-- Take an existing test and build it inside a
8774buildLoop :: 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)
8875buildLoop test (e1, e2) = switchHold never buildLoop
8976 where buildLoop = pushAlways (const $ test (e1, e2)) e2
9077
91−
9278connectButtonPromptly :: Widget t m => Event t () -> Event t a -> m (Event t a)
9379connectButtonPromptly click e = do
9480 d <- holdDyn never (e <$ click)
@@ -99,7 +85,6 @@ connectButton click e = do
9985 d <- hold never (e <$ click)
10086 return (switch d)
10187
102−
10388switchLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
10489switchLoop (e1, e2) = do
10590 rec
@@ -112,17 +97,12 @@ mergeLoop (e1, e2) = do
11297 rec
11398 (_, e) <- runEventWriterT $
11499 runWithReplace w (leftmost [w <$ e1])
115−
116100 return (sum <$> e)
117−
118101 where
119102 w = do
120103 c <- count e1
121104 tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
122105
123−
124−
125−
126106switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
127107switchLoop' (e1, e2) = do
128108 rec
@@ -130,7 +110,6 @@ switchLoop' (e1, e2) = do
130110 d <- count (leftmost [e', e1])
131111 return $ updated d
132112
133−
134113switchLoop2 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
135114switchLoop2 (e1, e2) = do
136115 rec
@@ -138,7 +117,6 @@ switchLoop2 (e1, e2) = do
138117 d <- count (align e' e1)
139118 return $ updated d
140119
141−
142120staticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
143121staticLoop (e1, e2) = do
144122 rec
@@ -151,7 +129,6 @@ staticLoop' (e1, e2) = do
151129 d <- foldDyn (+) (0 :: Int) (leftmost [e1, updated d])
152130 return $ updated d
153131
154−
155132buildStaticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
156133buildStaticLoop (e1, e2) = switchHold never buildLoop
157134 where buildLoop = pushAlways (const $ staticLoop (e1, e2)) e2
@@ -166,29 +143,22 @@ runTest (name, TestCase test) = do
166143 putStrLn ("Test: " <> name)
167144 mError <- timeout (milliseconds 5) $
168145 run `catch` \(e :: EventLoopException) -> pure (show e)
169−
170146 case mError of
171147 Just err -> putStrLn err
172148 Nothing -> error "timed out (loop not detected)"
173−
174149 where
175−
176150 run = do
177151 r <- runApp' (test . splitThese) (Just <$> occs)
178152 error (name <> ": unexpected success " <> show r)
179−
180153 occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
181−
182154 milliseconds = (*1000)
183155
184−
185156newtype TestCase = TestCase { unTest :: forall t m. (Widget t m, Adjustable t m) => (Event t Int, Event t ()) -> m (Event t Int) }
186157
187158tests :: [(String, TestCase)]
188159tests =
189160 [ ("switchLoop'", TestCase switchLoop')
190161 , ("switchLoop", TestCase switchLoop)
191−
192162 , ("mergeLoop", TestCase mergeLoop)
193163
194164
@@ -206,9 +176,3 @@ tests =
206176
207177main :: IO ()
208178main = traverse_ runTest tests
209−
210−
211−
212−
213−
214−