git.iko.soy/patch
on develop help sign in
Add saulzar's benchmarks.
66d5055Cale Gibbard
bench/RunAll.hsnew file+86
compare with develop
unifiedsplit
@@ -0,0 +1,86 @@
1+{-# LANGUAGE ConstraintKinds, TypeSynonymInstances, BangPatterns, ScopedTypeVariables, TupleSections, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+
4+module Main where
5+
6+import Criterion.Main
7+import Criterion.Types
8+
9+import Reflex
10+import Reflex.Host.Class
11+
12+import Reflex.TestPlan
13+import Reflex.Plan.Reflex
14+
15+import Reflex.Spider.Internal (SpiderEventHandle)
16+import qualified Reflex.Bench.Focused as Focused
17+
18+import Control.Applicative
19+import Control.DeepSeq (NFData (..))
20+
21+import System.IO
22+import System.Mem
23+import Prelude
24+
25+type MonadReflexHost' t m = (MonadReflexHost t m, MonadIORef m, MonadIORef (HostFrame t))
26+
27+
28+setupFiring :: (MonadReflexHost t m, MonadIORef m) => Plan t (Event t a) -> m (Ignore (EventHandle t a), Schedule t)
29+setupFiring p = do
30+ (e, s) <- runPlan p
31+ h <- subscribeEvent e
32+ return (Ignore h, s)
33+
34+-- Hack to avoid the NFData constraint for EventHandle which is a synonym
35+newtype Ignore a = Ignore a
36+instance NFData (Ignore a) where
37+ rnf !_ = ()
38+
39+instance NFData (SpiderEventHandle a) where
40+ rnf !_ = ()
41+
42+instance NFData (Behavior t a) where
43+ rnf !_ = ()
44+
45+instance NFData (Firing t) where
46+ rnf !(Firing _ _) = ()
47+
48+-- Measure the running time
49+benchFiring :: (MonadReflexHost' t m, MonadSample t m) => (forall a. m a -> IO a) -> (String, TestCase) -> Benchmark
50+benchFiring runHost (name, TestE p) = env setup (\e -> bench name $ whnfIO $ run e) where
51+ run (Ignore h, s) = runHost (readSchedule s (readEvent' h)) >> performGC
52+ setup = runHost $ setupFiring p
53+
54+benchFiring runHost (name, TestB p) = env setup (\e -> bench name $ whnfIO $ run e) where
55+ run (b, s) = runHost (readSchedule s (sample b)) >> performGC
56+ setup = runHost $ do
57+ (b, s) <- runPlan p
58+ return (b, makeDense s)
59+
60+main :: IO ()
61+main = do
62+ hSetBuffering stdout LineBuffering
63+ defaultMainWith (defaultConfig { timeLimit = 10, csvFile = Just "dmap-original.csv" })
64+ [ benchImpl "spider" runSpiderHost
65+ ]
66+
67+benchImpl :: (MonadReflexHost' t m, MonadSample t m) => String -> (forall a. m a -> IO a) -> Benchmark
68+benchImpl name runHost = bgroup name [ sub 100 40
69+ , dynamics 100
70+ , dynamics 1000
71+ , firing 1000
72+ , firing 10000
73+ , merging 10
74+ , merging 50
75+ , merging 100
76+ , merging 200]
77+ where
78+ sub n frames = runGroup ("subscribing " ++ show (n, frames)) $ Focused.subscribing n frames
79+ firing n = runGroup ("firing " ++ show n) $ Focused.firing n
80+ merging n = runGroup ("merging " ++ show n) $ Focused.merging n
81+ dynamics n = runGroup ("dynamics " ++ show n) $ Focused.dynamics n
82+
83+ runGroup name' benchmarks = bgroup name' (benchFiring runHost <$> benchmarks)
84+
85+
86+
test/Reflex/Bench/Focused.hsnew file+273
@@ -0,0 +1,273 @@
1+{-# LANGUAGE RecursiveDo, ConstraintKinds, TypeSynonymInstances, BangPatterns, ScopedTypeVariables, TupleSections, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
2+
3+module Reflex.Bench.Focused where
4+
5+import Reflex
6+import Reflex.TestPlan
7+
8+import Control.Monad.Fix
9+import Control.Monad
10+import Control.Applicative
11+import Data.Foldable
12+import Data.Traversable
13+
14+import Data.Maybe
15+import Data.Map (Map)
16+import qualified Data.Map as Map
17+
18+import Data.Tuple
19+import Data.List
20+import Data.List.Split
21+
22+import Prelude
23+
24+mergeTree :: Num a => (Monoid (f [a]), Functor f) => Int -> [f a] -> f a
25+mergeTree n es | length es <= n = sum' es
26+ | otherwise = mergeTree n subTrees
27+ where
28+ merges = chunksOf n es
29+ subTrees = map sum' merges
30+ sum' = fmap sum . mconcat . fmap (fmap (:[]) )
31+
32+mergeListDyn :: (Reflex t, MonadHold t m) => [Dynamic t a] -> m (Dynamic t [a])
33+mergeListDyn dyns = traverse (mapDyn pure) dyns >>= mconcatDyn
34+
35+mergeTreeDyn :: (Num a, Reflex t, MonadHold t m, MonadFix m) => Int -> [Dynamic t a] -> m (Dynamic t a)
36+mergeTreeDyn n dyns | length dyns <= n = sumDyns dyns
37+ | otherwise = traverse sumDyns merges >>= mergeTreeDyn n
38+ where
39+ merges = chunksOf n dyns
40+ sumDyns ds = mergeListDyn ds >>= mapDyn sum
41+
42+-- N events all firing for N frames
43+continuous :: TestPlan t m => Word -> Word -> m [Event t Word]
44+continuous n frames = for [1..n] $ \i -> plan $ (, i) <$> [1..frames]
45+
46+-- Fire N events once every P frames for total N frames (interspersed evenly)
47+occasional :: TestPlan t m => Word -> Word -> Word -> m [Event t Word]
48+occasional n period frames = traverse plan $ zipWith occs [1..] phases
49+ where
50+ phases = take (fromIntegral n) $ concat (repeat [1..period])
51+ occs i phase = (, i) <$> [1, phase+1..frames]
52+
53+-- Event which never fires (but isn't 'never')
54+never' :: TestPlan t m => m (Event t Word)
55+never' = plan []
56+
57+-- Event which fires once on first frame
58+event :: TestPlan t m => m (Event t Word)
59+event = plan [(1, 0)]
60+
61+-- Event which fires constantly over N frames
62+events :: TestPlan t m => Word -> m (Event t Word)
63+events n = plan $ (\i -> (i, i)) <$> [1..n]
64+
65+-- N events all originating from one event
66+fmapFan :: Reflex t => Word -> Event t Word -> [Event t Word]
67+fmapFan n e = (\i -> (+i) <$> e) <$> [1..n]
68+
69+-- Create an Event with a Map which is dense to size N
70+denseMap :: TestPlan t m => Word -> m (Event t (Map Word Word))
71+denseMap n = plan [(1, m)] where
72+ m = Map.fromList $ zip [1..n] [1..n]
73+
74+fmapChain :: Reflex t => Word -> Event t Word -> (Event t Word)
75+fmapChain 0 e = e
76+fmapChain n e = fmapChain (n - 1) (fmap (+1) e)
77+
78+mapDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
79+mapDynChain 0 d = return d
80+mapDynChain n d = mapDynChain (n - 1) =<< mapDyn (+1) d
81+
82+joinDynChain :: (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
85+
86+combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
87+combineDynChain 0 d = return d
88+combineDynChain n d = combineDynChain (n - 1) =<< combineDyn (+) d d
89+
90+pingPong :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> Event t a -> m (Event t a)
91+pingPong e1 e2 = do
92+ rec
93+ d <- foldDyn (const swap) (e1, e2) e
94+ let e = switch (fst <$> current d)
95+ return e
96+
97+switchFactors :: (Reflex t, MonadHold t m) => Word -> Event t Word -> m (Event t Word)
98+switchFactors 0 e = return e
99+switchFactors i e = do
100+ b <- hold ((+1) <$> e) (e <$ ffilter ((== 0) . (i `mod`)) e)
101+ switchFactors (i - 1) (switch b)
102+
103+switchChain :: (Reflex t, MonadHold t m, MonadFix m) => Word -> Event t Word -> m (Event t Word)
104+switchChain 0 e = return e
105+switchChain i e = switchChain (i - 1) =<< pingPong e ((+1) <$> e)
106+
107+switchChain2 :: (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])
110+
111+switchPromptlyChain :: (Reflex t, MonadHold t m) => Word -> Event t Word -> m (Event t Word)
112+switchPromptlyChain 0 e = return e
113+switchPromptlyChain i e = do
114+ d <- holdDyn e (e <$ e)
115+ switchPromptlyChain (i - 1) (switchPromptlyDyn d)
116+
117+coinChain :: Reflex t => Word -> Event t Word -> Event t Word
118+coinChain 0 e = e
119+coinChain n e = coinChain (n - 1) $ coincidence (e <$ e)
120+
121+pullChain :: Reflex t => Word -> Behavior t Word -> Behavior t Word
122+pullChain 0 b = b
123+pullChain n b = pullChain (n - 1) $ (+1) <$> b
124+
125+-- | Data type for a collection (a map) which is updated by providing differences
126+data UpdatedMap t k a = UpdatedMap (Map k a) (Event t (Map k (Maybe a)))
127+
128+-- This will hopefully become a primitive (faster!)
129+switchMergeEvents :: (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Event t a) -> m (Event t (Map k a))
130+switchMergeEvents mapChanges = switch . fmap mergeMap <$> holdMap mapChanges
131+
132+switchMergeBehaviors :: 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))
133+switchMergeBehaviors mapChanges = pull <$> joinMap <$> holdMap mapChanges
134+ where joinMap m = traverse sample =<< sample m
135+
136+-- | Turn an UpdatedMap into a Dynamic by applying the differences to the initial value
137+holdMapDyn :: (Reflex t, MonadHold t m, MonadFix m, Ord k) => UpdatedMap t k a -> m (Dynamic t (Map k a))
138+holdMapDyn (UpdatedMap initial changes) = foldDyn (flip (Map.foldWithKey modify)) initial changes
139+ where
140+ modify k Nothing items = Map.delete k items
141+ modify k (Just item) items = Map.insert k item items
142+
143+
144+-- | Hold an UpdatedMap as a behavior by applying differences to the initial value
145+holdMap :: (Reflex t, MonadHold t m, MonadFix m, Ord k) => UpdatedMap t k a -> m (Behavior t (Map k a))
146+holdMap = (current <$>) . holdMapDyn
147+
148+increasingMerge :: TestPlan t m => [a] -> m (UpdatedMap t Int a)
149+increasingMerge xs = do
150+ e <- planList (zipWith Map.singleton [1..] (Just <$> xs) ++ [reset])
151+ return (UpdatedMap Map.empty e)
152+ where
153+ reset = Map.fromList $ zip [1..] (const Nothing <$> xs)
154+
155+decreasingMerge :: (TestPlan t m) => [a] -> m (UpdatedMap t Int a)
156+decreasingMerge xs = do
157+ e <- planList (zipWith Map.singleton [1..] (const Nothing <$> xs) ++ [reset])
158+ return (UpdatedMap initial e)
159+ where
160+ initial = Map.fromList $ zip [1..] xs
161+ reset = Just <$> initial
162+
163+modifyMerge :: (TestPlan t m) => [a] -> m (UpdatedMap t Int a)
164+modifyMerge xs = do
165+ e <- planList $ zipWith Map.singleton [1..] (Just <$> xs)
166+ return (UpdatedMap initial e)
167+ where
168+ initial = Map.fromList $ zip [1..] xs
169+
170+countMany :: (Reflex t, MonadHold t m, MonadFix m) => [Event t a] -> m [Behavior t Int]
171+countMany = traverse (fmap current . count)
172+
173+countManyDyn :: (Reflex t, MonadHold t m, MonadFix m) => [Event t a] -> m [Dynamic t Int]
174+countManyDyn = traverse count
175+
176+-- Given a function which creates a sub-network (from a single event)
177+-- Create a plan which uses a switch to substitute it
178+switches :: TestPlan t m => Word -> (forall n. (MonadHold t n, MonadFix n) => Event t Word -> n (Event t a)) -> m (Event t a)
179+switches numFrames f = do
180+ es <- events numFrames
181+ switch <$> hold never (makeEvents es)
182+ where
183+ makeEvents es = pushAlways (\n -> f (fmap (+n) es)) es
184+
185+-- 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
187+subscribing :: Word -> Word -> [(String, TestCase)]
188+subscribing n frames =
189+ [ testE "fmapFan merge" $ switches frames (return . mergeList . fmapFan n)
190+ , testE "fmapFan/mergeTree" $ switches frames (return . mergeTree 8 . fmapFan n)
191+ , testE "fmapChain" $ switches frames (return . fmapChain n)
192+ , testE "switchChain" $ switches frames (switchChain n)
193+ , testE "switchPromptlyChain" $ switches frames (switchPromptlyChain n)
194+ , testE "switchFactors" $ switches frames (switchFactors n)
195+ , testE "coincidenceChain" $ switches frames (return . coinChain n)
196+ ]
197+
198+
199+-- Set of benchmark to test specifically merging dynamic collections
200+-- a pattern which occurs frequently in reflex-dom collections
201+merging :: Word -> [(String, TestCase)]
202+merging n =
203+ [ testE "static events" $ mergeList <$> sparse
204+ , testE "increasing events" $ switchMergeEvents =<< increasingMerge =<< sparse
205+ , testE "decreasing events" $ switchMergeEvents =<< decreasingMerge =<< sparse
206+ , testE "modify events" $ switchMergeEvents =<< modifyMerge =<< sparse
207+
208+ , testB "static behaviors" $ pull . traverse sample <$> counters
209+ , testB "increasing behaviors" $ switchMergeBehaviors =<< increasingMerge =<< counters
210+ , testB "decreasing behaviors" $ switchMergeBehaviors =<< decreasingMerge =<< counters
211+ , testB "modify behaviors" $ switchMergeBehaviors =<< modifyMerge =<< counters
212+ ]
213+
214+ where
215+ sparse :: TestPlan t m => m [Event t Word]
216+ sparse = fmap (fmap (+1)) <$> occasional n 8 n
217+
218+ counters :: TestPlan t m => m [Behavior t Int]
219+ counters = countMany =<< sparse
220+
221+dynamics :: Word -> [(String, TestCase)]
222+dynamics n =
223+ [ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
224+ , testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
225+ , testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
226+ , testE "dense mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< dense
227+ , testE "sparse mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< sparse
228+ , testE "mergeDyn" $ fmap updated $ mapDyn sum =<< mergeListDyn =<< sparse
229+ ] where
230+ d :: TestPlan t m => m (Dynamic t Word)
231+ d = count =<< events 10
232+
233+ sparse, dense :: TestPlan t m => m [Dynamic t Int]
234+ sparse = countManyDyn =<< occasional n 8 16
235+ dense = countManyDyn =<< continuous n 2
236+
237+
238+firing :: Word -> [(String, TestCase)]
239+firing n =
240+ [ testE "fmapChain" $ fmapChain n <$> e
241+ , testE "switchChain2" $ switchChain2 n =<< e
242+ , testE "switchPromptlyChain" $ switchPromptlyChain n =<< e
243+ , testE "switchFactors" $ switchFactors n =<< e
244+ , testE "coincidenceChain" $ coinChain n <$> e
245+
246+ , testE "dense mergeTree" $ mergeTree 8 <$> dense
247+ , testE "sparse mergeTree" $ mergeTree 8 <$> sparse
248+ , testE "runFrame" $ events n
249+ , testB "sum counters" $ do
250+ counts <- counters
251+ return $ pull $ sum <$> traverse sample counts
252+
253+ , testB "pullChain" $ pullChain n . current <$> (count =<< events 4)
254+ , testB "pullChain2" $ do
255+ e' <- events 4
256+ b <- hold (constant 0) $ leftmost
257+ [ constant 0 <$ ffilter (==4) e'
258+ , pushAlways (const $ pullChain n <$> hold 0 e') e'
259+ ]
260+ return (join b)
261+ , testB "counters/pullTree" $ mergeTree 8 <$> counters
262+ ]
263+ where
264+ e :: TestPlan t m => m (Event t Word)
265+ e = events 10
266+
267+ dense, sparse :: TestPlan t m => m [Event t Word]
268+ dense = continuous n 2
269+ sparse = occasional n 8 16
270+
271+ counters :: TestPlan t m => m [Behavior t Int]
272+ counters = countMany =<< sparse
273+
test/Reflex/Plan/Reflex.hsnew file+120
@@ -0,0 +1,120 @@
1+{-# LANGUAGE FunctionalDependencies, BangPatterns, UndecidableInstances, ConstraintKinds, GADTs, ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, RecursiveDo, FlexibleContexts, StandaloneDeriving #-}
2+module Reflex.Plan.Reflex
3+ ( TestPlan(..)
4+ , runPlan
5+ , Plan
6+ , Schedule
7+ , Firing (..)
8+ , MonadIORef
9+
10+
11+ , readSchedule
12+ , testSchedule
13+ , readEvent'
14+ , makeDense
15+
16+ , runTestE
17+ , runTestB
18+
19+ ) where
20+
21+import Reflex.Class
22+import Reflex.Host.Class
23+import Reflex.TestPlan
24+
25+import Control.Applicative
26+import Control.Monad
27+import Control.Monad.State.Strict
28+
29+import Data.Dependent.Sum (DSum (..))
30+import Data.Monoid
31+import Data.Maybe
32+import qualified Data.IntMap.Strict as IntMap
33+import Control.Monad.Ref
34+
35+
36+import Data.IntMap.Strict (IntMap)
37+import Data.IORef
38+import System.Mem
39+
40+-- Note: this import must come last to silence warnings from AMP
41+import Prelude
42+
43+type MonadIORef m = (MonadIO m, MonadRef m, Ref m ~ Ref IO)
44+
45+data Firing t where
46+ Firing :: IORef (Maybe (EventTrigger t a)) -> a -> Firing t
47+
48+
49+type Schedule t = IntMap [Firing t]
50+
51+-- Implementation of a TestPlan in terms of ReflexHost
52+newtype Plan t a = Plan (StateT (Schedule t) (HostFrame t) a)
53+
54+deriving instance ReflexHost t => Functor (Plan t)
55+deriving instance ReflexHost t => Applicative (Plan t)
56+deriving instance ReflexHost t => Monad (Plan t)
57+
58+deriving instance ReflexHost t => MonadSample t (Plan t)
59+deriving instance ReflexHost t => MonadHold t (Plan t)
60+deriving instance ReflexHost t => MonadFix (Plan t)
61+
62+
63+instance (ReflexHost t, MonadRef (HostFrame t), Ref (HostFrame t) ~ Ref IO) => TestPlan t (Plan t) where
64+ plan occurances = Plan $ do
65+ (e, ref) <- newEventWithTriggerRef
66+ modify (IntMap.unionWith mappend (firings ref))
67+ return e
68+
69+ where
70+ firings ref = IntMap.fromList (makeFiring ref <$> occurances)
71+ makeFiring ref (t, a) = (fromIntegral t, [Firing ref a])
72+
73+
74+firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t)))
75+firingTrigger (Firing ref a) = fmap (:=> a) <$> readRef ref
76+
77+runPlan :: (MonadReflexHost t m, MonadIORef m) => Plan t a -> m (a, Schedule t)
78+runPlan (Plan p) = runHostFrame $ runStateT p mempty
79+
80+
81+makeDense :: Schedule t -> Schedule t
82+makeDense s = fromMaybe (emptyRange 0) $ do
83+ (end, _) <- fst <$> IntMap.maxViewWithKey s
84+ return $ IntMap.union s (emptyRange end)
85+ where
86+ emptyRange end = IntMap.fromList (zip [0..end + 1] (repeat []))
87+
88+
89+-- For the purposes of testing, we add in a zero frame and extend one frame (to observe changes to behaviors
90+-- after the last event)
91+-- performGC is called at each frame to test for GC issues
92+testSchedule :: (MonadReflexHost t m, MonadIORef m) => Schedule t -> ReadPhase m a -> m (IntMap a)
93+testSchedule schedule readResult = IntMap.traverseWithKey (\t occs -> liftIO performGC *> triggerFrame readResult t occs) (makeDense schedule)
94+
95+readSchedule :: (MonadReflexHost t m, MonadIORef m) => Schedule t -> ReadPhase m a -> m (IntMap a)
96+readSchedule schedule readResult = IntMap.traverseWithKey (triggerFrame readResult) schedule
97+
98+triggerFrame :: (MonadReflexHost t m, MonadIORef m) => ReadPhase m a -> Int -> [Firing t] -> m a
99+triggerFrame readResult _ occs = do
100+ triggers <- {-# SCC "catMaybes/traverse" #-} catMaybes <$> traverse firingTrigger occs
101+ {-# SCC fireEventsAndRead #-} fireEventsAndRead triggers readResult
102+
103+
104+readEvent' :: MonadReadEvent t m => EventHandle t a -> m (Maybe a)
105+readEvent' = readEvent >=> sequence
106+
107+
108+-- Convenience functions for running tests producing Events/Behaviors
109+runTestB :: (MonadReflexHost t m, MonadIORef m) => Plan t (Behavior t a) -> m (IntMap a)
110+runTestB p = do
111+ (b, s) <- runPlan p
112+ testSchedule s $ sample b
113+
114+runTestE :: (MonadReflexHost t m, MonadIORef m) => Plan t (Event t a) -> m (IntMap (Maybe a))
115+runTestE p = do
116+ (e, s) <- runPlan p
117+ h <- subscribeEvent e
118+ testSchedule s (readEvent' h)
119+
120+
test/Reflex/TestPlan.hsnew file+45
@@ -0,0 +1,45 @@
1+{-# LANGUAGE FunctionalDependencies, BangPatterns, UndecidableInstances, ConstraintKinds, GADTs, ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, RecursiveDo, FlexibleContexts, StandaloneDeriving #-}
2+module Reflex.TestPlan
3+ ( TestPlan(..)
4+
5+ , TestCase (..)
6+ , testE, testB
7+ , TestE, TestB
8+
9+ , planList
10+
11+ ) where
12+
13+import Reflex.Class
14+import Control.Monad.Fix
15+
16+import qualified Data.IntMap as IntMap
17+import Data.IntMap
18+
19+import Prelude
20+
21+class (Reflex t, MonadHold t m, MonadFix m) => TestPlan t m where
22+ -- | Speicify a plan of an input Event firing
23+ -- Occurances must be in the future (i.e. Time > 0)
24+ -- Initial specification is
25+
26+ plan :: [(Word, a)] -> m (Event t a)
27+
28+
29+planList :: TestPlan t m => [a] -> m (Event t a)
30+planList xs = plan $ zip [1..] xs
31+
32+type TestE a = forall t m. TestPlan t m => m (Event t a)
33+type TestB a = forall t m. TestPlan t m => m (Behavior t a)
34+
35+data TestCase where
36+ TestE :: (Show a, Eq a) => TestE a -> TestCase
37+ TestB :: (Show a, Eq a) => TestB a -> TestCase
38+
39+-- Helpers to declare test cases
40+testE :: (Eq a, Show a) => String -> TestE a -> (String, TestCase)
41+testE name test = (name, TestE test)
42+
43+testB :: (Eq a, Show a) => String -> TestB a -> (String, TestCase)
44+testB name test = (name, TestB test)
45+