git.iko.soy/patch
on 73613bd help sign in
patch/test/Reflex/Test/Micro.hs
258 lines 6.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 Control.Monad
9import Control.Applicative
10import Data.Char
11import Data.Monoid
12import Data.Functor.Misc
14import Data.Foldable
16import qualified Data.Map as Map
18import Prelude
20testCases :: [(String, TestCase)]
21testCases =
22 [ testB "hold" $ hold "0" =<< events1
24 , testB "count" $ do
25 b <- current <$> (count =<< events2)
26 return $ (+ (0::Int)) <$> b
28 , testB "pull-1" $ do
29 b <- hold "0" =<< events1
30 return (id <$> id <$> b)
32 , testB "pull-2" $ do
33 b1 <- behavior1
34 return (id <$> pull $ liftA2 (<>) (sample b1) (sample b1))
36 , testB "pull-3" $ do
37 b1 <- behavior1
38 b2 <- behavior2
39 return (id <$> pull $ liftA2 (<>) (sample b1) (sample b2))
41 , testB "pull-4" $ do
42 es <- planList ["a", "b", "c"]
43 e <- plan [(0, ())]
44 b <- hold (constant "") $
45 pushAlways (const $ hold "z" es) e
46 return (join b)
48 , testE "tag-1" $ do
49 b1 <- behavior1
50 e <- events2
51 return (tag b1 e)
53 , testE "tag-2" $ do
54 b1 <- behavior1
55 e <- events2
56 return (tag (map toUpper <$> b1) e)
58 , testE "attach-1" $ do
59 b1 <- behavior1
60 e <- events2
61 return (attachWith (++) (map toUpper <$> b1) e)
63 , testE "leftmost" $ liftA2 leftmost2 events1 events2
65 , testE "appendEvents-1" $ liftA2 appendEvents events1 events2
67 , testE "appendEvents-2" $ liftA2 appendEvents events3 events2
69 , testE "merge-1" $ do
70 e <- events1
71 return $ leftmost ["x" <$ e, "y" <$ e]
73 , testE "merge-2" $ do
74 e <- events1
75 let m = mergeMap $ Map.fromList [(1::Int, "y" <$ e), (2, "z" <$ e)]
76 let ee = flip pushAlways e $ const $ return m
77 return $ coincidence ee
79 , testE "onceE-1" $ do
80 e <- events1
81 onceE $ leftmost [e, e]
83 , testE "onceE-2" $ do
84 e <- events1
85 b <- hold never (e <$ e)
86 onceE $ switch b
88 , testE "switch-1" $ do
89 e <- events1
90 b <- hold never (e <$ e)
91 return $ switch b
93 , testE "switch-2" $ do
94 e <- events1
95 return $ coincidence $ flip pushAlways e $ const $ do
96 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) (e <$ e)
98 , testE "switch-3" $ do
99 e <- events1
100 return $ coincidence $ flip pushAlways e $ const $ do
101 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) never
103 , testE "switch-4" $ do
104 e <- events1
105 switch <$> hold (deep e) (e <$ e)
107 , testE "switch-5" $ do
108 e <- events1
109 return $ coincidence $ flip pushAlways e $ const $
110 return $ leftmost ["x" <$ e, "y" <$ e, "z" <$ e]
112 , testE "switch-6" $ do
113 e <- events1
114 return $ coincidence $ flip pushAlways e $ const $ do
115 switch <$> hold ("x" <$ e) (e <$ e)
117 , testE "switchPromptly-1" $ do
118 e <- events1
119 let e' = e <$ e
120 switchPromptly never $ e <$ e'
122 , testE "switchPromptly-2" $ do
123 e <- events1
124 switchPromptly never $ deep (e <$ e)
126 , testE "switchPromptly-3" $ do
127 e <- events1
128 switchPromptly never $ (e <$ deep e)
130 , testE "switchPromptly-4" $ do
131 e <- events1
132 switchPromptly never $ (deep e <$ e)
134 , testE "switch-5" $ do
135 e <- events1
136 switch <$> hold never (deep e <$ e)
138 , testE "switchPromptly-5" $ do
139 e <- events1
140 switchPromptly never $ flip push e $
141 const (Just <$> onceE e)
143 , testE "switchPromptly-6" $ do
144 e <- events1
145 switchPromptly never $ flip pushAlways e $
146 const (switchPromptly e never)
148 , testE "coincidence-1" $ do
149 e <- events1
150 return $ coincidence $ flip pushAlways e $
151 const $ return (id <$> e)
153 , testE "coincidence-2" $ do
154 e <- events1
155 return $ coincidence $ flip pushAlways e $
156 const $ return (deep e)
158 , testE "coincidence-3" $ do
159 e <- events1
160 return $ coincidence $ flip pushAlways e $
161 const $ return (coincidence (e <$ e))
163 , testE "coincidence-4" $ do
164 e <- events1
165 return $ coincidence $ flip pushAlways e $
166 const (onceE e)
168 , testE "coincidence-5" $ do
169 e <- events1
170 return $ coincidence $ flip pushAlways e $ const $ do
171 let e' = deep e
172 return (coincidence (e' <$ e'))
174 , testE "coincidence-6" $ do
175 e <- events1
176 return $ coincidence $ flip pushAlways e $ const $ do
177 let e' = coincidence (e <$ e)
178 return $ deep e'
180 , testE "coincidence-7" $ do
181 e <- events1
182 return $ coincidence (deep e <$ e)
184 , testB "holdWhileFiring" $ do
185 e <- events1
186 eo <- onceE e
187 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
188 return $ pull $ sample =<< sample bb
190 , testE "joinDyn" $ do
191 e <- events1
192 bb <- hold "b" e
193 bd <- hold never . fmap (const e) =<< onceE e
195 eOuter <- pushAlways sample . fmap (const bb) <$> onceE e
196 let eInner = switch bd
197 return $ leftmost [eOuter, eInner]
199 , testB "foldDyn" $ do
200 d <- foldDyn (++) "0" =<< events1
201 return (current d)
203 , testB "mapDyn" $ do
204 d <- foldDyn (++) "0" =<< events1
205 current <$> mapDyn (map toUpper) d
207 , testB "combineDyn" $ do
208 d1 <- foldDyn (++) "0" =<< events1
209 d2 <- mapDyn (map toUpper) =<< foldDyn (++) "0" =<< events2
211 current <$> combineDyn (<>) d1 d2
212 , testE "fan-1" $ do
213 e <- fmap toMap <$> events1
214 let es = select (fanMap e) . Const2 <$> values
216 return (mergeList es)
218 , testE "fan-2" $ do
219 e <- fmap toMap <$> events3
220 let es = select (fanMap e) . Const2 <$> values
222 return (mergeList es)
224 , testE "fan-3" $ do
225 f <- fanMap <$> fmap toMap <$> events3
226 return $ select f (Const2 'c')
228 , testE "fan-4" $ do
229 e <- fmap toMap <$> events1
230 return $ toUpper <$> select (fanMap e) (Const2 'a')
232 , testE "fan-5" $ do
233 e <- fmap toMap <$> events2
234 return $ toUpper <$> select (fanMap e) (Const2 'c')
236 , testE "fan-6" $ do
237 f <- fanMap <$> fmap toMap <$> events1
238 return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]
240 ] where
242 events1, events2, events3 :: TestPlan t m => m (Event t String)
243 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
244 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
246 events3 = liftA2 appendEvents events1 events2
248 values = "abcde"
249 toMap str = Map.fromList $ map (\c -> (c, c)) str
251 behavior1, behavior2 :: forall t m. TestPlan t m => m (Behavior t String)
252 behavior1 = hold "1" =<< events1
253 behavior2 = hold "2" =<< events2
255 deep e = leftmost [e, e]
256 leftmost2 e1 e2 = leftmost [e1, e2]