git.iko.soy/patch
on develop help sign in
Merge pull request #43 from Saulzar/testing
d5e5518Ryan Trinkle
bench/Main.hs+7−6
compare with develop
unifiedsplit
@@ -7,6 +7,7 @@ module Main where
7import Data.Functor.Misc
7import Data.Functor.Misc
8import Control.Monad.Primitive
8import Control.Monad.Primitive
9import Control.Monad.IO.Class
9import Control.Monad.IO.Class
10+import Control.Monad.Identity
10import Data.Dependent.Sum
11import Data.Dependent.Sum
11import Control.Concurrent.STM
12import Control.Concurrent.STM
12import Control.Applicative
13import Control.Applicative
@@ -73,7 +74,7 @@ micros =
73 (newEventWithTriggerRef >>= subscribePair)
74 (newEventWithTriggerRef >>= subscribePair)
74 (\(subd, trigger) -> do
75 (\(subd, trigger) -> do
75 Just key <- liftIO $ readIORef trigger
76 Just key <- liftIO $ readIORef trigger
76− fireEvents [key :=> (42 :: Int)])
77+ fireEvents [key :=> Identity (42 :: Int)])
77 , withSetupWHNF "fireEventsAndRead(head/merge1)"
78 , withSetupWHNF "fireEventsAndRead(head/merge1)"
78 (setupMerge 1 >>= subscribePair)
79 (setupMerge 1 >>= subscribePair)
79 (\(subd, t:riggers) -> fireAndRead t (42 :: Int) subd)
80 (\(subd, t:riggers) -> fireAndRead t (42 :: Int) subd)
@@ -87,17 +88,17 @@ micros =
87 (setupMerge 100 >>= subscribePair)
88 (setupMerge 100 >>= subscribePair)
88 (\(subd, t:riggers) -> do
89 (\(subd, t:riggers) -> do
89 Just key <- liftIO $ readIORef t
90 Just key <- liftIO $ readIORef t
90− fireEvents [key :=> (42 :: Int)])
91+ fireEvents [key :=> Identity (42 :: Int)])
91 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev,trigger) -> hold (42 :: Int) ev
92 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev,trigger) -> hold (42 :: Int) ev
92− , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample
93+ , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample
93 ]
94 ]
94
95
95setupMerge :: Int
96setupMerge :: Int
96− -> SpiderHost (Event Spider (DM.DMap (Const2 Int a)),
97+ -> SpiderHost (Event Spider (DM.DMap (Const2 Int a) Identity),
97 [IORef (Maybe (EventTrigger Spider a))])
98 [IORef (Maybe (EventTrigger Spider a))])
98setupMerge num = do
99setupMerge num = do
99 (evs, triggers) <- unzip <$> replicateM 100 newEventWithTriggerRef
100 (evs, triggers) <- unzip <$> replicateM 100 newEventWithTriggerRef
100− let !m = DM.fromList [WrapArg (Const2 i) :=> v | (i,v) <- zip [0..] evs]
101+ let !m = DM.fromList [(Const2 i) :=> v | (i,v) <- zip [0..] evs]
101 pure (merge m, triggers)
102 pure (merge m, triggers)
102
103
103subscribePair :: (Event Spider a, b) -> SpiderHost (EventHandle Spider a, b)
104subscribePair :: (Event Spider a, b) -> SpiderHost (EventHandle Spider a, b)
@@ -107,4 +108,4 @@ fireAndRead :: IORef (Maybe (EventTrigger Spider a)) -> a -> EventHandle Spider
107 -> SpiderHost (Maybe b)
108 -> SpiderHost (Maybe b)
108fireAndRead trigger val subd = do
109fireAndRead trigger val subd = do
109 Just key <- liftIO $ readIORef trigger
110 Just key <- liftIO $ readIORef trigger
110− fireEventsAndRead [key :=> val] $ readEvent subd >>= T.sequence
111+ fireEventsAndRead [key :=> Identity val] $ readEvent subd >>= T.sequence
reflex.cabal+10−6
@@ -46,12 +46,11 @@ library
46 other-extensions: TemplateHaskell
46 other-extensions: TemplateHaskell
47 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
47 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
48
48
49+
49−test-suite cross-impl
50+test-suite all
50 type: exitcode-stdio-1.0
51 type: exitcode-stdio-1.0
51− main-is: Reflex/Test/CrossImpl.hs
52+ main-is: Reflex/Test/RunAll.hs
52− other-modules:
53− Reflex.Pure
54− ghc-options: -O2 -main-is Reflex.Test.CrossImpl.test
53+ ghc-options: -O2 -Wall
55 hs-source-dirs: test
54 hs-source-dirs: test
56 build-depends:
55 build-depends:
57 base,
56 base,
@@ -60,7 +59,12 @@ test-suite cross-impl
60 mtl,
59 mtl,
61 containers,
60 containers,
62 dependent-map,
61 dependent-map,
62+ dependent-sum,
63+ transformers >= 0.3 && < 0.5,
63− MemoTrie == 0.6.*
64+ MemoTrie == 0.6.*,
65+ bifunctors,
66+ split
67+
64
68
65benchmark spider-bench
69benchmark spider-bench
66 type: exitcode-stdio-1.0
70 type: exitcode-stdio-1.0
test/Reflex/Bench/Focused.hs+127−40
@@ -7,19 +7,28 @@ import Reflex.TestPlan
7
7
8import Control.Monad.Fix
8import Control.Monad.Fix
9import Control.Monad
9import Control.Monad
10+import Control.Monad.Identity
10import Control.Applicative
11import Control.Applicative
11−import Data.Foldable
12+--import Data.Foldable
12−import Data.Traversable
13+import Data.Traversable (traverse, for)
13
14
14import Data.Maybe
15import Data.Maybe
15import Data.Map (Map)
16import Data.Map (Map)
16import qualified Data.Map as Map
17import qualified Data.Map as Map
18+import qualified Data.Dependent.Map as DMap
19+
20+import Data.Functor.Misc
17
21
18import Data.Tuple
22import Data.Tuple
19import Data.List
23import Data.List
20import Data.List.Split
24import Data.List.Split
21
25
22−import Prelude
26+import Data.Word
27+import Data.Monoid
28+
29+
30+import Prelude hiding (sum, concat)
31+
23
32
24mergeTree :: Num a => (Monoid (f [a]), Functor f) => Int -> [f a] -> f a
33mergeTree :: Num a => (Monoid (f [a]), Functor f) => Int -> [f a] -> f a
25mergeTree n es | length es <= n = sum' es
34mergeTree n es | length es <= n = sum' es
@@ -39,6 +48,8 @@ mergeTreeDyn n dyns | length dyns <= n = sumDyns dyns
39 merges = chunksOf n dyns
48 merges = chunksOf n dyns
40 sumDyns ds = mergeListDyn ds >>= mapDyn sum
49 sumDyns ds = mergeListDyn ds >>= mapDyn sum
41
50
51+
52+
42-- N events all firing for N frames
53-- N events all firing for N frames
43continuous :: TestPlan t m => Word -> Word -> m [Event t Word]
54continuous :: TestPlan t m => Word -> Word -> m [Event t Word]
44continuous n frames = for [1..n] $ \i -> plan $ (, i) <$> [1..frames]
55continuous n frames = for [1..n] $ \i -> plan $ (, i) <$> [1..frames]
@@ -50,10 +61,13 @@ occasional n period frames = traverse plan $ zipWith occs [1..] phases
50 phases = take (fromIntegral n) $ concat (repeat [1..period])
61 phases = take (fromIntegral n) $ concat (repeat [1..period])
51 occs i phase = (, i) <$> [1, phase+1..frames]
62 occs i phase = (, i) <$> [1, phase+1..frames]
52
63
64+
65+
53-- Event which never fires (but isn't 'never')
66-- Event which never fires (but isn't 'never')
54never' :: TestPlan t m => m (Event t Word)
67never' :: TestPlan t m => m (Event t Word)
55never' = plan []
68never' = plan []
56
69
70+
57-- Event which fires once on first frame
71-- Event which fires once on first frame
58event :: TestPlan t m => m (Event t Word)
72event :: TestPlan t m => m (Event t Word)
59event = plan [(1, 0)]
73event = plan [(1, 0)]
@@ -62,30 +76,53 @@ event = plan [(1, 0)]
62events :: TestPlan t m => Word -> m (Event t Word)
76events :: TestPlan t m => Word -> m (Event t Word)
63events n = plan $ (\i -> (i, i)) <$> [1..n]
77events n = plan $ (\i -> (i, i)) <$> [1..n]
64
78
79+
65-- N events all originating from one event
80-- N events all originating from one event
66fmapFan :: Reflex t => Word -> Event t Word -> [Event t Word]
81fmapFan :: Reflex t => Word -> Event t Word -> [Event t Word]
67fmapFan n e = (\i -> (+i) <$> e) <$> [1..n]
82fmapFan n e = (\i -> (+i) <$> e) <$> [1..n]
68
83
84+
85+-- Make a fan using the value in the event converting it to a singleton Map
86+-- use a fan of size n (key is the value mod n)
87+fanMerge :: Reflex t => Word -> Event t Word -> Event t Word
88+fanMerge n e = leftmost $ s <$> [0..n - 1] where
89+ s k = select f (Const2 k)
90+ f = fan (toMap <$> e)
91+ toMap k = DMap.singleton (Const2 $ k `mod` n) (Identity k)
92+
93+-- Dumb version of the above using simple fmapMaybe to filter
94+fmapFanMerge :: Reflex t => Word -> Event t Word -> Event t Word
95+fmapFanMerge n e = leftmost $ s <$> [0..n - 1] where
96+ s k = flip fmapMaybe e $ \j -> if (k == j `mod` n)
97+ then Just k
98+ else Nothing
99+
100+
101+
69-- Create an Event with a Map which is dense to size N
102-- Create an Event with a Map which is dense to size N
70denseMap :: TestPlan t m => Word -> m (Event t (Map Word Word))
103denseMap :: TestPlan t m => Word -> m (Event t (Map Word Word))
71denseMap n = plan [(1, m)] where
104denseMap n = plan [(1, m)] where
72 m = Map.fromList $ zip [1..n] [1..n]
105 m = Map.fromList $ zip [1..n] [1..n]
73
106
74−fmapChain :: Reflex t => Word -> Event t Word -> (Event t Word)
107+iter :: (a -> a) -> Word -> a -> a
75−fmapChain 0 e = e
108+iter _ 0 a = a
76−fmapChain n e = fmapChain (n - 1) (fmap (+1) e)
109+iter f n a = iter f (n - 1) (f a)
110+
111+iterM :: Monad m => (a -> m a) -> Word -> a -> m a
112+iterM _ 0 a = return a
113+iterM f n a = iterM f (n - 1) =<< f a
114+
115+fmapChain :: (Functor f) => Word -> f Word -> f Word
116+fmapChain = iter (fmap (+1))
77
117
78mapDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
118mapDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
79−mapDynChain 0 d = return d
119+mapDynChain = iterM (mapDyn (+1))
80−mapDynChain n d = mapDynChain (n - 1) =<< mapDyn (+1) d
81
120
82joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
121joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
83−joinDynChain 0 d = return d
84−joinDynChain n d = joinDynChain (n - 1) =<< joinDyn <$> mapDyn (const d) d
122+joinDynChain = iterM (\d -> joinDyn <$> mapDyn (const d) d)
85
123
86combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
124combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
87−combineDynChain 0 d = return d
125+combineDynChain = iterM (\d -> combineDyn (+) d d)
88−combineDynChain n d = combineDynChain (n - 1) =<< combineDyn (+) d d
89
126
90pingPong :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> Event t a -> m (Event t a)
127pingPong :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> Event t a -> m (Event t a)
91pingPong e1 e2 = do
128pingPong e1 e2 = do
@@ -100,27 +137,27 @@ switchFactors i e = do
100 b <- hold ((+1) <$> e) (e <$ ffilter ((== 0) . (i `mod`)) e)
137 b <- hold ((+1) <$> e) (e <$ ffilter ((== 0) . (i `mod`)) e)
101 switchFactors (i - 1) (switch b)
138 switchFactors (i - 1) (switch b)
102
139
140+
103switchChain :: (Reflex t, MonadHold t m, MonadFix m) => Word -> Event t Word -> m (Event t Word)
141switchChain :: (Reflex t, MonadHold t m, MonadFix m) => Word -> Event t Word -> m (Event t Word)
104−switchChain 0 e = return e
142+switchChain = iterM (\e -> pingPong e ((+1) <$> e))
105−switchChain i e = switchChain (i - 1) =<< pingPong e ((+1) <$> e)
143+
106
144
107switchChain2 :: (Reflex t, MonadHold t m, MonadFix m) => Word -> Event t Word -> m (Event t Word)
145switchChain2 :: (Reflex t, MonadHold t m, MonadFix m) => Word -> Event t Word -> m (Event t Word)
108−switchChain2 0 e = return e
109−switchChain2 i e = switchChain2 (i - 1) =<< pingPong e ((+1) <$> leftmost [e, e])
146+switchChain2 = iterM (\e -> pingPong e ((+1) <$> leftmost [e, e]))
110
147
111switchPromptlyChain :: (Reflex t, MonadHold t m) => Word -> Event t Word -> m (Event t Word)
148switchPromptlyChain :: (Reflex t, MonadHold t m) => Word -> Event t Word -> m (Event t Word)
112−switchPromptlyChain 0 e = return e
149+switchPromptlyChain = iterM $ \e ->
113−switchPromptlyChain i e = do
114− d <- holdDyn e (e <$ e)
150+ switchPromptlyDyn <$> holdDyn e (e <$ e)
115− switchPromptlyChain (i - 1) (switchPromptlyDyn d)
151+
116
152
117coinChain :: Reflex t => Word -> Event t Word -> Event t Word
153coinChain :: Reflex t => Word -> Event t Word -> Event t Word
118−coinChain 0 e = e
154+coinChain = iter $ \e -> coincidence (e <$ e)
119−coinChain n e = coinChain (n - 1) $ coincidence (e <$ e)
155+
156+fanMergeChain :: Reflex t => Word -> Word -> Event t Word -> Event t Word
157+fanMergeChain width = iter $ fanMerge width
120
158
121−pullChain :: Reflex t => Word -> Behavior t Word -> Behavior t Word
159+fmapFanMergeChain :: Reflex t => Word -> Word -> Event t Word -> Event t Word
122−pullChain 0 b = b
160+fmapFanMergeChain width = iter $ fmapFanMerge width
123−pullChain n b = pullChain (n - 1) $ (+1) <$> b
124
161
125-- | Data type for a collection (a map) which is updated by providing differences
162-- | Data type for a collection (a map) which is updated by providing differences
126data UpdatedMap t k a = UpdatedMap (Map k a) (Event t (Map k (Maybe a)))
163data UpdatedMap t k a = UpdatedMap (Map k a) (Event t (Map k (Maybe a)))
@@ -129,6 +166,9 @@ data UpdatedMap t k a = UpdatedMap (Map k a) (Event t (Map k (Maybe a)))
129switchMergeEvents :: (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Event t a) -> m (Event t (Map k a))
166switchMergeEvents :: (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Event t a) -> m (Event t (Map k a))
130switchMergeEvents mapChanges = switch . fmap mergeMap <$> holdMap mapChanges
167switchMergeEvents mapChanges = switch . fmap mergeMap <$> holdMap mapChanges
131
168
169+-- switchMergeMaybe :: (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Event t a) -> m (Event t (Map k a))
170+-- switchMergeMaybe (UpdatedMap initial changes) = switchMergeMap initial (fmap (fromMaybe never) <$> changes)
171+
132switchMergeBehaviors :: forall a t m k. (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Behavior t a) -> m (Behavior t (Map k a))
172switchMergeBehaviors :: forall a t m k. (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Behavior t a) -> m (Behavior t (Map k a))
133switchMergeBehaviors mapChanges = pull <$> joinMap <$> holdMap mapChanges
173switchMergeBehaviors mapChanges = pull <$> joinMap <$> holdMap mapChanges
134 where joinMap m = traverse sample =<< sample m
174 where joinMap m = traverse sample =<< sample m
@@ -136,6 +176,7 @@ switchMergeBehaviors mapChanges = pull <$> joinMap <$> holdMap mapChanges
136-- | Turn an UpdatedMap into a Dynamic by applying the differences to the initial value
176-- | Turn an UpdatedMap into a Dynamic by applying the differences to the initial value
137holdMapDyn :: (Reflex t, MonadHold t m, MonadFix m, Ord k) => UpdatedMap t k a -> m (Dynamic t (Map k a))
177holdMapDyn :: (Reflex t, MonadHold t m, MonadFix m, Ord k) => UpdatedMap t k a -> m (Dynamic t (Map k a))
138holdMapDyn (UpdatedMap initial changes) = foldDyn (flip (Map.foldWithKey modify)) initial changes
178holdMapDyn (UpdatedMap initial changes) = foldDyn (flip (Map.foldWithKey modify)) initial changes
179+
139 where
180 where
140 modify k Nothing items = Map.delete k items
181 modify k Nothing items = Map.delete k items
141 modify k (Just item) items = Map.insert k item items
182 modify k (Just item) items = Map.insert k item items
@@ -145,6 +186,7 @@ holdMapDyn (UpdatedMap initial changes) = foldDyn (flip (Map.foldWithKey modify)
145holdMap :: (Reflex t, MonadHold t m, MonadFix m, Ord k) => UpdatedMap t k a -> m (Behavior t (Map k a))
186holdMap :: (Reflex t, MonadHold t m, MonadFix m, Ord k) => UpdatedMap t k a -> m (Behavior t (Map k a))
146holdMap = (current <$>) . holdMapDyn
187holdMap = (current <$>) . holdMapDyn
147
188
189+
148increasingMerge :: TestPlan t m => [a] -> m (UpdatedMap t Int a)
190increasingMerge :: TestPlan t m => [a] -> m (UpdatedMap t Int a)
149increasingMerge xs = do
191increasingMerge xs = do
150 e <- planList (zipWith Map.singleton [1..] (Just <$> xs) ++ [reset])
192 e <- planList (zipWith Map.singleton [1..] (Just <$> xs) ++ [reset])
@@ -167,34 +209,43 @@ modifyMerge xs = do
167 where
209 where
168 initial = Map.fromList $ zip [1..] xs
210 initial = Map.fromList $ zip [1..] xs
169
211
212+
170countMany :: (Reflex t, MonadHold t m, MonadFix m) => [Event t a] -> m [Behavior t Int]
213countMany :: (Reflex t, MonadHold t m, MonadFix m) => [Event t a] -> m [Behavior t Int]
171countMany = traverse (fmap current . count)
214countMany = traverse (fmap current . count)
172
215
173countManyDyn :: (Reflex t, MonadHold t m, MonadFix m) => [Event t a] -> m [Dynamic t Int]
216countManyDyn :: (Reflex t, MonadHold t m, MonadFix m) => [Event t a] -> m [Dynamic t Int]
174countManyDyn = traverse count
217countManyDyn = traverse count
175
218
219+
176-- Given a function which creates a sub-network (from a single event)
220-- Given a function which creates a sub-network (from a single event)
177-- Create a plan which uses a switch to substitute it
221-- Create a plan which uses a switch to substitute it
178switches :: TestPlan t m => Word -> (forall n. (MonadHold t n, MonadFix n) => Event t Word -> n (Event t a)) -> m (Event t a)
222switches :: TestPlan t m => Word -> (forall n. (MonadHold t n, MonadFix n) => Event t Word -> n (Event t a)) -> m (Event t a)
179switches numFrames f = do
223switches numFrames f = do
180 es <- events numFrames
224 es <- events numFrames
181 switch <$> hold never (makeEvents es)
225 switch <$> hold never (makeEvents es)
226+
182 where
227 where
183 makeEvents es = pushAlways (\n -> f (fmap (+n) es)) es
228 makeEvents es = pushAlways (\n -> f (fmap (+n) es)) es
184
229
230+
231+
185-- Two sets of benchmarks, one which we're interested in testing subscribe time (as well as time to fire frames)
232-- Two sets of benchmarks, one which we're interested in testing subscribe time (as well as time to fire frames)
186-- the other, which we're only interested in time for running frames
233-- the other, which we're only interested in time for running frames
187subscribing :: Word -> Word -> [(String, TestCase)]
234subscribing :: Word -> Word -> [(String, TestCase)]
188subscribing n frames =
235subscribing n frames =
189− [ testE "fmapFan merge" $ switches frames (return . mergeList . fmapFan n)
236+ [ testSub "fmapFanMerge" $ return . mergeList . fmapFan n
237+ , testSub "fanMerge" $ return . fanMerge n
190− , testE "fmapFan/mergeTree" $ switches frames (return . mergeTree 8 . fmapFan n)
238+ , testSub "fmapFan/mergeTree" $ return . mergeTree 8 . fmapFan n
191− , testE "fmapChain" $ switches frames (return . fmapChain n)
239+ , testSub "fmapChain" $ return . fmapChain n
192− , testE "switchChain" $ switches frames (switchChain n)
240+ , testSub "switchChain" $ switchChain n
193− , testE "switchPromptlyChain" $ switches frames (switchPromptlyChain n)
241+ , testSub "switchPromptlyChain" $ switchPromptlyChain n
194− , testE "switchFactors" $ switches frames (switchFactors n)
242+ , testSub "switchFactors" $ switchFactors n
195− , testE "coincidenceChain" $ switches frames (return . coinChain n)
243+ , testSub "coincidenceChain" $ return . coinChain n
196 ]
244 ]
197
245
246+ where
247+ testSub :: (Eq a, Show a) => String -> (forall t n. (Reflex t, MonadHold t n, MonadFix n) => Event t Word -> n (Event t a)) -> (String, TestCase)
248+ testSub name test = testE name (switches frames test)
198
249
199-- Set of benchmark to test specifically merging dynamic collections
250-- Set of benchmark to test specifically merging dynamic collections
200-- a pattern which occurs frequently in reflex-dom collections
251-- a pattern which occurs frequently in reflex-dom collections
@@ -209,6 +260,11 @@ merging n =
209 , testB "increasing behaviors" $ switchMergeBehaviors =<< increasingMerge =<< counters
260 , testB "increasing behaviors" $ switchMergeBehaviors =<< increasingMerge =<< counters
210 , testB "decreasing behaviors" $ switchMergeBehaviors =<< decreasingMerge =<< counters
261 , testB "decreasing behaviors" $ switchMergeBehaviors =<< decreasingMerge =<< counters
211 , testB "modify behaviors" $ switchMergeBehaviors =<< modifyMerge =<< counters
262 , testB "modify behaviors" $ switchMergeBehaviors =<< modifyMerge =<< counters
263+
264+
265+ -- , testE "increasing events/switchMerge" $ switchMergeMaybe =<< increasingMerge =<< sparse
266+ -- , testE "decreasing events/switchMerge" $ switchMergeMaybe =<< decreasingMerge =<< sparse
267+ -- , testE "modify events/switchMerge" $ switchMergeMaybe =<< modifyMerge =<< sparse
212 ]
268 ]
213
269
214 where
270 where
@@ -218,15 +274,37 @@ merging n =
218 counters :: TestPlan t m => m [Behavior t Int]
274 counters :: TestPlan t m => m [Behavior t Int]
219 counters = countMany =<< sparse
275 counters = countMany =<< sparse
220
276
277+
278+
279+fans :: Word -> [(String, TestCase)]
280+fans n =
281+ [ testE "fanMapChain" $ fanMergeChain n 10 <$> e
282+ , testE "fmapFanMapChain" $ fmapFanMergeChain n 10 <$> e
283+
284+ , testE "fanMerge " $ fanMerge n <$> events n
285+
286+ , testE "fmapFanMerge " $ fmapFanMerge n <$> events n
287+ , testE "triggerMerge" $ leftmost <$> for [1..n] (\i -> plan [(i, i)])
288+
289+ ]
290+ where
291+
292+ e :: TestPlan t m => m (Event t Word)
293+ e = events 100
294+
295+
296+
297+
221dynamics :: Word -> [(String, TestCase)]
298dynamics :: Word -> [(String, TestCase)]
222dynamics n =
299dynamics n =
223 [ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
300 [ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
224 , testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
301 , testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
225 , testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
302 , testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
226− , testE "dense mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< dense
303+ , testE "dense mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< dense
227 , testE "sparse mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< sparse
304 , testE "sparse mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< sparse
228 , testE "mergeDyn" $ fmap updated $ mapDyn sum =<< mergeListDyn =<< sparse
305 , testE "mergeDyn" $ fmap updated $ mapDyn sum =<< mergeListDyn =<< sparse
229 ] where
306 ] where
307+
230 d :: TestPlan t m => m (Dynamic t Word)
308 d :: TestPlan t m => m (Dynamic t Word)
231 d = count =<< events 10
309 d = count =<< events 10
232
310
@@ -245,20 +323,25 @@ firing n =
245
323
246 , testE "dense mergeTree" $ mergeTree 8 <$> dense
324 , testE "dense mergeTree" $ mergeTree 8 <$> dense
247 , testE "sparse mergeTree" $ mergeTree 8 <$> sparse
325 , testE "sparse mergeTree" $ mergeTree 8 <$> sparse
326+
327+ -- Triggers test failure in Spider
248− , testE "runFrame" $ events n
328+ --, testE "runFrame" $ events n
329+
249 , testB "sum counters" $ do
330 , testB "sum counters" $ do
250 counts <- counters
331 counts <- counters
251 return $ pull $ sum <$> traverse sample counts
332 return $ pull $ sum <$> traverse sample counts
252
333
253− , testB "pullChain" $ pullChain n . current <$> (count =<< events 4)
334+ , testB "pullChain" $ fmapChain n . current <$> (count =<< events 4)
254 , testB "pullChain2" $ do
335 , testB "pullChain2" $ do
255− e' <- events 4
336+ es <- events 4
256− b <- hold (constant 0) $ leftmost
337+ e <- plan [(0, ())]
257− [ constant 0 <$ ffilter (==4) e'
338+
339+ b <- hold (constant 0) $
258− , pushAlways (const $ pullChain n <$> hold 0 e') e'
340+ pushAlways (const $ fmapChain n <$> hold 0 es) e
259− ]
341+
260 return (join b)
342 return (join b)
261 , testB "counters/pullTree" $ mergeTree 8 <$> counters
343 , testB "counters/pullTree" $ mergeTree 8 <$> counters
344+
262 ]
345 ]
263 where
346 where
264 e :: TestPlan t m => m (Event t Word)
347 e :: TestPlan t m => m (Event t Word)
@@ -271,3 +354,7 @@ firing n =
271 counters :: TestPlan t m => m [Behavior t Int]
354 counters :: TestPlan t m => m [Behavior t Int]
272 counters = countMany =<< sparse
355 counters = countMany =<< sparse
273
356
357+
358+
359+
360+
test/Reflex/Plan/Pure.hsnew file+62
@@ -0,0 +1,62 @@
1+{-# LANGUAGE GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
2+
3+module Reflex.Plan.Pure where
4+
5+import Reflex
6+import Reflex.Pure
7+import Reflex.TestPlan
8+
9+import Control.Applicative
10+import Control.Monad.Fix
11+import Control.Monad.State
12+import Data.IntMap (IntMap)
13+import qualified Data.IntMap as IntMap
14+import Data.IntSet (IntSet)
15+import qualified Data.IntSet as IntSet
16+
17+import Data.Monoid
18+import Data.Bifunctor
19+import Data.Maybe
20+import Prelude
21+
22+
23+mapToPureEvent :: IntMap a -> Event (Pure Int) a
24+mapToPureEvent m = Event $ flip IntMap.lookup m
25+
26+type TimeM = (->) Int
27+newtype PurePlan a = PurePlan { unPlan :: StateT IntSet TimeM a } deriving (Functor, Applicative, Monad, MonadFix)
28+
29+liftPlan :: TimeM a -> PurePlan a
30+liftPlan = PurePlan . lift
31+
32+instance MonadHold (Pure Int) PurePlan where
33+ hold initial = liftPlan . hold initial
34+
35+instance MonadSample (Pure Int) PurePlan where
36+ sample = liftPlan . sample
37+
38+
39+instance TestPlan (Pure Int) PurePlan where
40+ plan occs = do
41+ PurePlan . modify $ IntSet.union (IntMap.keysSet m)
42+ return $ mapToPureEvent m
43+ where m = IntMap.fromList (first fromIntegral <$> occs)
44+
45+runPure :: PurePlan a -> (a, IntSet)
46+runPure (PurePlan p) = runStateT p mempty $ 0
47+
48+relavantTimes :: IntSet -> IntSet
49+relavantTimes occs = IntSet.fromList [0..l + 1]
50+ where l = fromMaybe 0 (fst <$> IntSet.maxView occs)
51+
52+testBehavior :: (Behavior (Pure Int) a, IntSet) -> IntMap a
53+testBehavior (b, occs) = IntMap.fromSet (sample b) (relavantTimes occs)
54+
55+testEvent :: (Event (Pure Int) a, IntSet) -> IntMap (Maybe a)
56+testEvent (Event readEvent, occs) = IntMap.fromSet readEvent (relavantTimes occs)
57+
58+
59+
60+
61+
62+
test/Reflex/Plan/Reflex.hs+7−5
@@ -24,10 +24,12 @@ import Reflex.TestPlan
24
24
25import Control.Applicative
25import Control.Applicative
26import Control.Monad
26import Control.Monad
27+import Control.Monad.Identity
27import Control.Monad.State.Strict
28import Control.Monad.State.Strict
28
29
29import Data.Dependent.Sum (DSum (..))
30import Data.Dependent.Sum (DSum (..))
30import Data.Monoid
31import Data.Monoid
32+import Data.Traversable (traverse, sequenceA)
31import Data.Maybe
33import Data.Maybe
32import qualified Data.IntMap.Strict as IntMap
34import qualified Data.IntMap.Strict as IntMap
33import Control.Monad.Ref
35import Control.Monad.Ref
@@ -71,8 +73,8 @@ instance (ReflexHost t, MonadRef (HostFrame t), Ref (HostFrame t) ~ Ref IO) => T
71 makeFiring ref (t, a) = (fromIntegral t, [Firing ref a])
73 makeFiring ref (t, a) = (fromIntegral t, [Firing ref a])
72
74
73
75
74−firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t)))
76+firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t) Identity))
75−firingTrigger (Firing ref a) = fmap (:=> a) <$> readRef ref
77+firingTrigger (Firing ref a) = fmap (:=> Identity a) <$> readRef ref
76
78
77runPlan :: (MonadReflexHost t m, MonadIORef m) => Plan t a -> m (a, Schedule t)
79runPlan :: (MonadReflexHost t m, MonadIORef m) => Plan t a -> m (a, Schedule t)
78runPlan (Plan p) = runHostFrame $ runStateT p mempty
80runPlan (Plan p) = runHostFrame $ runStateT p mempty
@@ -97,12 +99,12 @@ readSchedule schedule readResult = IntMap.traverseWithKey (triggerFrame readResu
97
99
98triggerFrame :: (MonadReflexHost t m, MonadIORef m) => ReadPhase m a -> Int -> [Firing t] -> m a
100triggerFrame :: (MonadReflexHost t m, MonadIORef m) => ReadPhase m a -> Int -> [Firing t] -> m a
99triggerFrame readResult _ occs = do
101triggerFrame readResult _ occs = do
100− triggers <- {-# SCC "catMaybes/traverse" #-} catMaybes <$> traverse firingTrigger occs
102+ triggers <- catMaybes <$> traverse firingTrigger occs
101− {-# SCC fireEventsAndRead #-} fireEventsAndRead triggers readResult
103+ fireEventsAndRead triggers readResult
102
104
103
105
104readEvent' :: MonadReadEvent t m => EventHandle t a -> m (Maybe a)
106readEvent' :: MonadReadEvent t m => EventHandle t a -> m (Maybe a)
105−readEvent' = readEvent >=> sequence
107+readEvent' = readEvent >=> sequenceA
106
108
107
109
108-- Convenience functions for running tests producing Events/Behaviors
110-- Convenience functions for running tests producing Events/Behaviors
test/Reflex/Pure.hs+1−2
@@ -9,8 +9,7 @@ module Reflex.Pure where
9
9
10import Reflex.Class
10import Reflex.Class
11import Data.Functor.Misc
11import Data.Functor.Misc
12−import Control.Monad.Identity
12+import Data.Functor.Identity
13−import Control.Monad
14import Data.MemoTrie
13import Data.MemoTrie
15import Data.Dependent.Map (DMap, GCompare)
14import Data.Dependent.Map (DMap, GCompare)
16import qualified Data.Dependent.Map as DMap
15import qualified Data.Dependent.Map as DMap
test/Reflex/Test.hsnew file+61
@@ -0,0 +1,61 @@
1+{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
2+
3+module Reflex.Test
4+ ( testAgreement
5+ , compareResult
6+ , runTests
7+
8+ , module Reflex.TestPlan
9+
10+ ) where
11+
12+import Reflex.Spider
13+
14+import Reflex.TestPlan
15+
16+import Reflex.Plan.Pure
17+import Reflex.Plan.Reflex
18+
19+import Control.Monad
20+import Data.Monoid
21+
22+import Data.IntMap (IntMap)
23+
24+--import Data.Foldable
25+import System.Exit
26+
27+import Prelude
28+
29+
30+testAgreement :: TestCase -> IO Bool
31+testAgreement (TestE p) = do
32+ spider <- runSpiderHost $ runTestE p
33+ let results = [("spider", spider)]
34+
35+ compareResult results (testEvent $ runPure p)
36+
37+testAgreement (TestB p) = do
38+ spider <- runSpiderHost $ runTestB p
39+ let results = [("spider", spider)]
40+
41+ compareResult results (testBehavior $ runPure p)
42+
43+
44+compareResult :: (Show a, Eq a) => [(String, IntMap a)] -> IntMap a -> IO Bool
45+compareResult results expected = fmap and $ forM results $ \(name, r) -> do
46+
47+ when (r /= expected) $ do
48+ putStrLn ("Got: " ++ show (name, r))
49+ putStrLn ("Expected: " ++ show expected)
50+ return (r == expected)
51+
52+
53+runTests :: [(String, TestCase)] -> IO ()
54+runTests testCases = do
55+ results <- forM testCases $ \(name, test) -> do
56+ putStrLn $ "Test: " <> name
57+ testAgreement test
58+ exitWith $ if and results
59+ then ExitSuccess
60+ else ExitFailure 1
61+
test/Reflex/Test/Micro.hsnew file+299
@@ -0,0 +1,299 @@
1+{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
2+
3+module Reflex.Test.Micro (testCases) where
4+
5+import Reflex
6+import Reflex.TestPlan
7+
8+import Data.Word
9+import Control.Monad
10+import Control.Applicative
11+import Data.Char
12+import Data.Monoid
13+import Data.Functor.Misc
14+
15+import Data.Foldable
16+
17+import Data.Map (Map)
18+import qualified Data.Map as Map
19+
20+import Prelude
21+
22+testCases :: [(String, TestCase)]
23+testCases =
24+ [ testB "hold" $ hold "0" =<< events1
25+ , testB "count" $ do
26+ b <- current <$> (count =<< events2)
27+ return $ (+ (0::Int)) <$> b
28+
29+ , testB "pull-1" $ do
30+ b <- hold "0" =<< events1
31+ return (id <$> id <$> b)
32+
33+
34+ , testB "pull-2" $ do
35+ b1 <- behavior1
36+ return (id <$> pull $ liftA2 (<>) (sample b1) (sample b1))
37+
38+ , testB "pull-3" $ do
39+ b1 <- behavior1
40+ b2 <- behavior2
41+ return (id <$> pull $ liftA2 (<>) (sample b1) (sample b2))
42+
43+ , testB "pull-4" $ do
44+ es <- planList ["a", "b", "c"]
45+ e <- plan [(0, ())]
46+
47+ b <- hold (constant "") $
48+ pushAlways (const $ hold "z" es) e
49+
50+ return (join b)
51+
52+ , testE "tag-1" $ do
53+ b1 <- behavior1
54+ e <- events2
55+ return (tag b1 e)
56+
57+ , testE "tag-2" $ do
58+ b1 <- behavior1
59+ e <- events2
60+ return (tag (map toUpper <$> b1) e)
61+
62+ , testE "attach-1" $ do
63+ b1 <- behavior1
64+ e <- events2
65+ return (attachWith (++) (map toUpper <$> b1) e)
66+
67+ , testE "leftmost" $ liftA2 leftmost2 events1 events2
68+
69+ , testE "appendEvents-1" $ liftA2 appendEvents events1 events2
70+ , testE "appendEvents-2" $ liftA2 appendEvents events3 events2
71+
72+
73+ , testE "merge-1" $ do
74+ e <- events1
75+ return $ leftmost ["x" <$ e, "y" <$ e]
76+
77+ , testE "merge-2" $ do
78+ e <- events1
79+ let m = mergeMap $ Map.fromList [(1::Int, "y" <$ e), (2, "z" <$ e)]
80+
81+ let ee = flip pushAlways e $ const $ return m
82+ return $ coincidence ee
83+
84+ , testE "onceE-1" $ do
85+ e <- events1
86+ onceE $ leftmost [e, e]
87+
88+
89+ , testE "onceE-2" $ do
90+ e <- events1
91+ b <- hold never (e <$ e)
92+ onceE $ switch b
93+
94+
95+ , testE "switch-1" $ do
96+ e <- events1
97+ b <- hold never (e <$ e)
98+ return $ switch b
99+
100+ , testE "switch-2" $ do
101+ e <- events1
102+ return $ coincidence $ flip pushAlways e $ const $ do
103+ switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) (e <$ e)
104+
105+ , testE "switch-3" $ do
106+ e <- events1
107+ return $ coincidence $ flip pushAlways e $ const $ do
108+ switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) never
109+
110+ , testE "switch-4" $ do
111+ e <- events1
112+ switch <$> hold (deep e) (e <$ e)
113+
114+
115+ , testE "switch-5" $ do
116+ e <- events1
117+ return $ coincidence $ flip pushAlways e $ const $
118+ return $ leftmost ["x" <$ e, "y" <$ e, "z" <$ e]
119+
120+ , testE "switch-6" $ do
121+ e <- events1
122+ return $ coincidence $ flip pushAlways e $ const $ do
123+ switch <$> hold ("x" <$ e) (e <$ e)
124+
125+
126+ , testE "switchPromptly-1" $ do
127+ e <- events1
128+ let e' = e <$ e
129+ switchPromptly never $ e <$ e'
130+
131+ , testE "switchPromptly-2" $ do
132+ e <- events1
133+ switchPromptly never $ deep (e <$ e)
134+
135+ , testE "switchPromptly-3" $ do
136+ e <- events1
137+ switchPromptly never $ (e <$ deep e)
138+
139+ , testE "switchPromptly-4" $ do
140+ e <- events1
141+ switchPromptly never $ (deep e <$ e)
142+
143+ , testE "switch-5" $ do
144+ e <- events1
145+ switch <$> hold never (deep e <$ e)
146+
147+ , testE "switchPromptly-5" $ do
148+ e <- events1
149+ switchPromptly never $ flip push e $
150+ const (Just <$> onceE e)
151+
152+ , testE "switchPromptly-6" $ do
153+ e <- events1
154+ switchPromptly never $ flip pushAlways e $
155+ const (switchPromptly e never)
156+
157+ , testE "coincidence-1" $ do
158+ e <- events1
159+ return $ coincidence $ flip pushAlways e $
160+ const $ return (id <$> e)
161+
162+ , testE "coincidence-2" $ do
163+ e <- events1
164+ return $ coincidence $ flip pushAlways e $
165+ const $ return (deep e)
166+
167+ , testE "coincidence-3" $ do
168+ e <- events1
169+ return $ coincidence $ flip pushAlways e $
170+ const $ return (coincidence (e <$ e))
171+
172+ , testE "coincidence-4" $ do
173+ e <- events1
174+ return $ coincidence $ flip pushAlways e $
175+ const (onceE e)
176+
177+ , testE "coincidence-5" $ do
178+ e <- events1
179+ return $ coincidence $ flip pushAlways e $ const $ do
180+ let e' = deep e
181+ return (coincidence (e' <$ e'))
182+
183+ , testE "coincidence-6" $ do
184+ e <- events1
185+ return $ coincidence $ flip pushAlways e $ const $ do
186+ let e' = coincidence (e <$ e)
187+ return $ deep e'
188+
189+ , testE "coincidence-7" $ do
190+ e <- events1
191+ return $ coincidence (deep e <$ e)
192+
193+ , testB "holdWhileFiring" $ do
194+ e <- events1
195+ eo <- onceE e
196+ bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
197+ return $ pull $ sample =<< sample bb
198+
199+ , testE "joinDyn" $ do
200+ e <- events1
201+ bb <- hold "b" e
202+ bd <- hold never . fmap (const e) =<< onceE e
203+
204+ eOuter <- pushAlways sample . fmap (const bb) <$> onceE e
205+ let eInner = switch bd
206+ return $ leftmost [eOuter, eInner]
207+
208+ , testB "foldDyn" $ do
209+ d <- foldDyn (++) "0" =<< events1
210+ return (current d)
211+
212+ , testB "mapDyn" $ do
213+ d <- foldDyn (++) "0" =<< events1
214+ current <$> mapDyn (map toUpper) d
215+
216+ , testB "combineDyn" $ do
217+ d1 <- foldDyn (++) "0" =<< events1
218+ d2 <- mapDyn (map toUpper) =<< foldDyn (++) "0" =<< events2
219+
220+ current <$> combineDyn (<>) d1 d2
221+ , testE "fan-1" $ do
222+ e <- fmap toMap <$> events1
223+ let es = select (fanMap e) . Const2 <$> values
224+
225+ return (mergeList es)
226+
227+ , testE "fan-2" $ do
228+ e <- fmap toMap <$> events3
229+ let es = select (fanMap e) . Const2 <$> values
230+
231+ return (mergeList es)
232+
233+ , testE "fan-3" $ do
234+ f <- fanMap <$> fmap toMap <$> events3
235+ return $ select f (Const2 'c')
236+
237+ , testE "fan-4" $ do
238+ e <- fmap toMap <$> events1
239+ return $ toUpper <$> select (fanMap e) (Const2 'a')
240+
241+ , testE "fan-5" $ do
242+ e <- fmap toMap <$> events2
243+ return $ toUpper <$> select (fanMap e) (Const2 'c')
244+
245+ , testE "fan-6" $ do
246+ f <- fanMap <$> fmap toMap <$> events1
247+ return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]
248+
249+ -- , testE "switchMerge-1" $ switchMergeMap mempty =<< increasing
250+
251+ -- , testE "switchMerge-2" $ do
252+ -- e <- eventsFrom 0
253+ -- switchMergeMap (Map.singleton 0 e) =<< increasing
254+
255+ -- , testE "switchMerge-3" $ do
256+ -- es <- eventsMany
257+ -- switchMergeMap es =<< increasing
258+
259+ -- , testE "switchMerge-4" $ do
260+ -- es <- eventsMany
261+ -- switchMergeMap es =<< decreasing
262+
263+ ] where
264+
265+ events1, events2, events3 :: TestPlan t m => m (Event t String)
266+ events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
267+ events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
268+
269+ events3 = liftA2 appendEvents events1 events2
270+
271+ eventsFrom :: TestPlan t m => Word -> m (Event t Int)
272+ eventsFrom n = plan $ zip [n..8] [1..8]
273+
274+ increasing :: TestPlan t m => m (Event t (Map Int (Event t Int)))
275+ increasing = do
276+ es <- mapM eventsFrom [1..8]
277+ planList $ zipWith Map.singleton [1..8] es
278+
279+ decreasing :: TestPlan t m => m (Event t (Map Int (Event t Int)))
280+ decreasing = planList $ zipWith Map.singleton [1..8] (repeat never)
281+
282+ eventsMany :: TestPlan t m => m (Map Int (Event t Int))
283+ eventsMany = do
284+ es <- mapM eventsFrom [8,7..1]
285+ return $ Map.fromList $ zip [1..8] es
286+
287+
288+ values = "abcde"
289+ toMap str = Map.fromList $ map (\c -> (c, c)) str
290+
291+
292+ behavior1, behavior2 :: forall t m. TestPlan t m => m (Behavior t String)
293+ behavior1 = hold "1" =<< events1
294+ behavior2 = hold "2" =<< events2
295+
296+ deep e = leftmost [e, e]
297+ leftmost2 e1 e2 = leftmost [e1, e2]
298+
299+
test/Reflex/Test/RunAll.hsnew file+44
@@ -0,0 +1,44 @@
1+{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
2+
3+module Main (main) where
4+
5+import Reflex.Test
6+
7+import qualified Reflex.Bench.Focused as Focused
8+import qualified Reflex.Test.Micro as Micro
9+import Data.Functor
10+import Data.Bifunctor
11+import Data.List
12+
13+import System.Exit
14+import System.Environment
15+
16+import Prelude
17+
18+matchPrefixes :: [String] -> (String -> Bool)
19+matchPrefixes [] = const True
20+matchPrefixes args = \name -> any (`isPrefixOf` name) args
21+
22+
23+main :: IO ()
24+main = do
25+ args <- getArgs
26+
27+ case args of
28+ ["--list"] -> mapM_ putStrLn (fst <$> allTests) >> exitWith (ExitFailure 1)
29+ _ -> case filter (matchPrefixes args . fst) allTests of
30+ [] -> putStrLn "filter did not match any tests" >> exitWith (ExitFailure 1)
31+ tests -> runTests tests
32+
33+ where
34+ allTests = concat
35+ [ makeGroup "micro" Micro.testCases
36+ , makeGroup "subscribing (100,40)" (Focused.subscribing 100 40)
37+ , makeGroup "firing 1000" (Focused.firing 1000)
38+ , makeGroup "merge 100" (Focused.merging 100)
39+ , makeGroup "fan 50" (Focused.fans 50)
40+ ]
41+
42+ makeGroup name tests = first (\test -> intercalate "/" [name, test]) <$> tests
43+
44+
test/Reflex/TestPlan.hs+1−2
@@ -12,9 +12,8 @@ module Reflex.TestPlan
12
12
13import Reflex.Class
13import Reflex.Class
14import Control.Monad.Fix
14import Control.Monad.Fix
15+import Data.Word
15
16
16−import qualified Data.IntMap as IntMap
17−import Data.IntMap
18
17
19import Prelude
18import Prelude
20
19