git.iko.soy/reflex
on 7bb5ff4 help sign in
reflex/test/Reflex/Test/Micro.hs
299 lines 7.9 kB history raw
1{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
3module Reflex.Test.Micro (testCases) where
5import Reflex
6import Reflex.TestPlan
8import Data.Word
9import Control.Monad
10import Control.Applicative
11import Data.Char
12import Data.Monoid
13import Data.Functor.Misc
15import Data.Foldable
17import Data.Map (Map)
18import qualified Data.Map as Map
20import Prelude
22testCases :: [(String, TestCase)]
23testCases =
24 [ testB "hold" $ hold "0" =<< events1
25 , testB "count" $ do
26 b <- current <$> (count =<< events2)
27 return $ (+ (0::Int)) <$> b
29 , testB "pull-1" $ do
30 b <- hold "0" =<< events1
31 return (id <$> id <$> b)
34 , testB "pull-2" $ do
35 b1 <- behavior1
36 return (id <$> pull $ liftA2 (<>) (sample b1) (sample b1))
38 , testB "pull-3" $ do
39 b1 <- behavior1
40 b2 <- behavior2
41 return (id <$> pull $ liftA2 (<>) (sample b1) (sample b2))
43 , testB "pull-4" $ do
44 es <- planList ["a", "b", "c"]
45 e <- plan [(0, ())]
47 b <- hold (constant "") $
48 pushAlways (const $ hold "z" es) e
50 return (join b)
52 , testE "tag-1" $ do
53 b1 <- behavior1
54 e <- events2
55 return (tag b1 e)
57 , testE "tag-2" $ do
58 b1 <- behavior1
59 e <- events2
60 return (tag (map toUpper <$> b1) e)
62 , testE "attach-1" $ do
63 b1 <- behavior1
64 e <- events2
65 return (attachWith (++) (map toUpper <$> b1) e)
67 , testE "leftmost" $ liftA2 leftmost2 events1 events2
69 , testE "appendEvents-1" $ liftA2 appendEvents events1 events2
70 , testE "appendEvents-2" $ liftA2 appendEvents events3 events2
73 , testE "merge-1" $ do
74 e <- events1
75 return $ leftmost ["x" <$ e, "y" <$ e]
77 , testE "merge-2" $ do
78 e <- events1
79 let m = mergeMap $ Map.fromList [(1::Int, "y" <$ e), (2, "z" <$ e)]
81 let ee = flip pushAlways e $ const $ return m
82 return $ coincidence ee
84 , testE "onceE-1" $ do
85 e <- events1
86 onceE $ leftmost [e, e]
89 , testE "onceE-2" $ do
90 e <- events1
91 b <- hold never (e <$ e)
92 onceE $ switch b
95 , testE "switch-1" $ do
96 e <- events1
97 b <- hold never (e <$ e)
98 return $ switch b
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)
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
110 , testE "switch-4" $ do
111 e <- events1
112 switch <$> hold (deep e) (e <$ e)
115 , testE "switch-5" $ do
116 e <- events1
117 return $ coincidence $ flip pushAlways e $ const $
118 return $ leftmost ["x" <$ e, "y" <$ e, "z" <$ e]
120 , testE "switch-6" $ do
121 e <- events1
122 return $ coincidence $ flip pushAlways e $ const $ do
123 switch <$> hold ("x" <$ e) (e <$ e)
126 , testE "switchPromptly-1" $ do
127 e <- events1
128 let e' = e <$ e
129 switchPromptly never $ e <$ e'
131 , testE "switchPromptly-2" $ do
132 e <- events1
133 switchPromptly never $ deep (e <$ e)
135 , testE "switchPromptly-3" $ do
136 e <- events1
137 switchPromptly never $ (e <$ deep e)
139 , testE "switchPromptly-4" $ do
140 e <- events1
141 switchPromptly never $ (deep e <$ e)
143 , testE "switch-5" $ do
144 e <- events1
145 switch <$> hold never (deep e <$ e)
147 , testE "switchPromptly-5" $ do
148 e <- events1
149 switchPromptly never $ flip push e $
150 const (Just <$> onceE e)
152 , testE "switchPromptly-6" $ do
153 e <- events1
154 switchPromptly never $ flip pushAlways e $
155 const (switchPromptly e never)
157 , testE "coincidence-1" $ do
158 e <- events1
159 return $ coincidence $ flip pushAlways e $
160 const $ return (id <$> e)
162 , testE "coincidence-2" $ do
163 e <- events1
164 return $ coincidence $ flip pushAlways e $
165 const $ return (deep e)
167 , testE "coincidence-3" $ do
168 e <- events1
169 return $ coincidence $ flip pushAlways e $
170 const $ return (coincidence (e <$ e))
172 , testE "coincidence-4" $ do
173 e <- events1
174 return $ coincidence $ flip pushAlways e $
175 const (onceE e)
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'))
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'
189 , testE "coincidence-7" $ do
190 e <- events1
191 return $ coincidence (deep e <$ e)
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
199 , testE "joinDyn" $ do
200 e <- events1
201 bb <- hold "b" e
202 bd <- hold never . fmap (const e) =<< onceE e
204 eOuter <- pushAlways sample . fmap (const bb) <$> onceE e
205 let eInner = switch bd
206 return $ leftmost [eOuter, eInner]
208 , testB "foldDyn" $ do
209 d <- foldDyn (++) "0" =<< events1
210 return (current d)
212 , testB "mapDyn" $ do
213 d <- foldDyn (++) "0" =<< events1
214 current <$> mapDyn (map toUpper) d
216 , testB "combineDyn" $ do
217 d1 <- foldDyn (++) "0" =<< events1
218 d2 <- mapDyn (map toUpper) =<< foldDyn (++) "0" =<< events2
220 current <$> combineDyn (<>) d1 d2
221 , testE "fan-1" $ do
222 e <- fmap toMap <$> events1
223 let es = select (fanMap e) . Const2 <$> values
225 return (mergeList es)
227 , testE "fan-2" $ do
228 e <- fmap toMap <$> events3
229 let es = select (fanMap e) . Const2 <$> values
231 return (mergeList es)
233 , testE "fan-3" $ do
234 f <- fanMap <$> fmap toMap <$> events3
235 return $ select f (Const2 'c')
237 , testE "fan-4" $ do
238 e <- fmap toMap <$> events1
239 return $ toUpper <$> select (fanMap e) (Const2 'a')
241 , testE "fan-5" $ do
242 e <- fmap toMap <$> events2
243 return $ toUpper <$> select (fanMap e) (Const2 'c')
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') ]
249 -- , testE "switchMerge-1" $ switchMergeMap mempty =<< increasing
251 -- , testE "switchMerge-2" $ do
252 -- e <- eventsFrom 0
253 -- switchMergeMap (Map.singleton 0 e) =<< increasing
255 -- , testE "switchMerge-3" $ do
256 -- es <- eventsMany
257 -- switchMergeMap es =<< increasing
259 -- , testE "switchMerge-4" $ do
260 -- es <- eventsMany
261 -- switchMergeMap es =<< decreasing
263 ] where
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")]
269 events3 = liftA2 appendEvents events1 events2
271 eventsFrom :: TestPlan t m => Word -> m (Event t Int)
272 eventsFrom n = plan $ zip [n..8] [1..8]
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
279 decreasing :: TestPlan t m => m (Event t (Map Int (Event t Int)))
280 decreasing = planList $ zipWith Map.singleton [1..8] (repeat never)
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
288 values = "abcde"
289 toMap str = Map.fromList $ map (\c -> (c, c)) str
292 behavior1, behavior2 :: forall t m. TestPlan t m => m (Behavior t String)
293 behavior1 = hold "1" =<< events1
294 behavior2 = hold "2" =<< events2
296 deep e = leftmost [e, e]
297 leftmost2 e1 e2 = leftmost [e1, e2]