git.iko.soy/reflex
on develop help sign in
Clean up whitespace
ffb450eleon.smith@obsidian.systems
test/DebugCycles.hs−36
compare with develop
unifiedsplit
@@ -15,28 +15,19 @@ import Control.Applicative
15import Control.Monad
15import Control.Monad
16import Control.Monad.Fix
16import Control.Monad.Fix
17import Control.Exception
17import Control.Exception
18−
19import System.Timeout
18import System.Timeout
20−
21import Data.Maybe (isJust)
19import Data.Maybe (isJust)
22import Data.Functor.Misc
20import Data.Functor.Misc
23import qualified Data.Map as Map
21import qualified Data.Map as Map
24import Data.Map (Map)
22import Data.Map (Map)
25−
26import qualified Data.IntMap as IntMap
23import qualified Data.IntMap as IntMap
27import Data.IntMap (IntMap)
24import Data.IntMap (IntMap)
28−
29−
30import Data.These
25import Data.These
31import Data.Align
26import Data.Align
32−
33import Reflex
27import Reflex
34import Reflex.EventWriter.Base
28import Reflex.EventWriter.Base
35import Test.Run
29import Test.Run
36−
37import Reflex.Spider.Internal (EventLoopException)
30import Reflex.Spider.Internal (EventLoopException)
38−
39−
40import Data.Witherable (Filterable)
31import Data.Witherable (Filterable)
41
32
42#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
33#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
45
36
46type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
37type Widget t m = (MonadHold t m, Reflex t, MonadFix m)
47
38
48−
49connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
39connectDyn ::Widget t m => Event t () -> (Dynamic t a, Dynamic t a) -> m (Dynamic t a)
50connectDyn e (d, d') = do
40connectDyn e (d, d') = do
51 dd <- holdDyn d (d' <$ e)
41 dd <- holdDyn d (d' <$ e)
52 return $ join dd
42 return $ join dd
53
43
54−
55dynLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
44dynLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
56dynLoop (e1, e2) = do
45dynLoop (e1, e2) = do
57 -- "heightBagRemove: Height 2 not present in bag HeightBag {_heightBag_size = 2, _heightBag_contents = fromList [(0,1)]}"
46 -- "heightBagRemove: Height 2 not present in bag HeightBag {_heightBag_size = 2, _heightBag_contents = fromList [(0,1)]}"
@@ -74,7 +63,6 @@ coincidenceLoop (e1, e2) = do
74 d <- count (align e' e1)
63 d <- count (align e' e1)
75 return $ updated d
64 return $ updated d
76
65
77−
78addHeight :: Reflex t => Event t a -> Event t a
66addHeight :: Reflex t => Event t a -> Event t a
79addHeight e = leftmost [e4, e4] where
67addHeight e = leftmost [e4, e4] where
80 e1 = leftmost [e, e]
68 e1 = leftmost [e, e]
@@ -82,13 +70,11 @@ addHeight e = leftmost [e4, e4] where
82 e3 = leftmost [e2, e2]
70 e3 = leftmost [e2, e2]
83 e4 = leftmost [e3, e3]
71 e4 = leftmost [e3, e3]
84
72
85−
86-- Take an existing test and build it inside a
73-- Take an existing test and build it inside a
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)
74buildLoop :: 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)
88buildLoop test (e1, e2) = switchHold never buildLoop
75buildLoop test (e1, e2) = switchHold never buildLoop
89 where buildLoop = pushAlways (const $ test (e1, e2)) e2
76 where buildLoop = pushAlways (const $ test (e1, e2)) e2
90
77
91−
92connectButtonPromptly :: Widget t m => Event t () -> Event t a -> m (Event t a)
78connectButtonPromptly :: Widget t m => Event t () -> Event t a -> m (Event t a)
93connectButtonPromptly click e = do
79connectButtonPromptly click e = do
94 d <- holdDyn never (e <$ click)
80 d <- holdDyn never (e <$ click)
@@ -99,7 +85,6 @@ connectButton click e = do
99 d <- hold never (e <$ click)
85 d <- hold never (e <$ click)
100 return (switch d)
86 return (switch d)
101
87
102−
103switchLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
88switchLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
104switchLoop (e1, e2) = do
89switchLoop (e1, e2) = do
105 rec
90 rec
@@ -112,17 +97,12 @@ mergeLoop (e1, e2) = do
112 rec
97 rec
113 (_, e) <- runEventWriterT $
98 (_, e) <- runEventWriterT $
114 runWithReplace w (leftmost [w <$ e1])
99 runWithReplace w (leftmost [w <$ e1])
115−
116 return (sum <$> e)
100 return (sum <$> e)
117−
118 where
101 where
119 w = do
102 w = do
120 c <- count e1
103 c <- count e1
121 tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
104 tellEvent (updated ((pure <$> c) :: Dynamic t [Int]))
122
105
123−
124−
125−
126switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
106switchLoop' :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
127switchLoop' (e1, e2) = do
107switchLoop' (e1, e2) = do
128 rec
108 rec
@@ -130,7 +110,6 @@ switchLoop' (e1, e2) = do
130 d <- count (leftmost [e', e1])
110 d <- count (leftmost [e', e1])
131 return $ updated d
111 return $ updated d
132
112
133−
134switchLoop2 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
113switchLoop2 :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
135switchLoop2 (e1, e2) = do
114switchLoop2 (e1, e2) = do
136 rec
115 rec
@@ -138,7 +117,6 @@ switchLoop2 (e1, e2) = do
138 d <- count (align e' e1)
117 d <- count (align e' e1)
139 return $ updated d
118 return $ updated d
140
119
141−
142staticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
120staticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
143staticLoop (e1, e2) = do
121staticLoop (e1, e2) = do
144 rec
122 rec
@@ -151,7 +129,6 @@ staticLoop' (e1, e2) = do
151 d <- foldDyn (+) (0 :: Int) (leftmost [e1, updated d])
129 d <- foldDyn (+) (0 :: Int) (leftmost [e1, updated d])
152 return $ updated d
130 return $ updated d
153
131
154−
155buildStaticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
132buildStaticLoop :: Widget t m => (Event t Int, Event t ()) -> m (Event t Int)
156buildStaticLoop (e1, e2) = switchHold never buildLoop
133buildStaticLoop (e1, e2) = switchHold never buildLoop
157 where buildLoop = pushAlways (const $ staticLoop (e1, e2)) e2
134 where buildLoop = pushAlways (const $ staticLoop (e1, e2)) e2
@@ -166,29 +143,22 @@ runTest (name, TestCase test) = do
166 putStrLn ("Test: " <> name)
143 putStrLn ("Test: " <> name)
167 mError <- timeout (milliseconds 5) $
144 mError <- timeout (milliseconds 5) $
168 run `catch` \(e :: EventLoopException) -> pure (show e)
145 run `catch` \(e :: EventLoopException) -> pure (show e)
169−
170 case mError of
146 case mError of
171 Just err -> putStrLn err
147 Just err -> putStrLn err
172 Nothing -> error "timed out (loop not detected)"
148 Nothing -> error "timed out (loop not detected)"
173−
174 where
149 where
175−
176 run = do
150 run = do
177 r <- runApp' (test . splitThese) (Just <$> occs)
151 r <- runApp' (test . splitThese) (Just <$> occs)
178 error (name <> ": unexpected success " <> show r)
152 error (name <> ": unexpected success " <> show r)
179−
180 occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
153 occs = [ This 1, This 2, That (), This 3, That (), This 1 ]
181−
182 milliseconds = (*1000)
154 milliseconds = (*1000)
183
155
184−
185newtype TestCase = TestCase { unTest :: forall t m. (Widget t m, Adjustable t m) => (Event t Int, Event t ()) -> m (Event t Int) }
156newtype TestCase = TestCase { unTest :: forall t m. (Widget t m, Adjustable t m) => (Event t Int, Event t ()) -> m (Event t Int) }
186
157
187tests :: [(String, TestCase)]
158tests :: [(String, TestCase)]
188tests =
159tests =
189 [ ("switchLoop'", TestCase switchLoop')
160 [ ("switchLoop'", TestCase switchLoop')
190 , ("switchLoop", TestCase switchLoop)
161 , ("switchLoop", TestCase switchLoop)
191−
192 , ("mergeLoop", TestCase mergeLoop)
162 , ("mergeLoop", TestCase mergeLoop)
193
163
194
164
@@ -206,9 +176,3 @@ tests =
206
176
207main :: IO ()
177main :: IO ()
208main = traverse_ runTest tests
178main = traverse_ runTest tests
209−
210−
211−
212−
213−
214−