git.iko.soy/patch
on 20dd2fe help sign in
patch/test/Reflex/Test/Micro.hs
263 lines 6.9 kB history raw
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE RankNTypes #-}
8module Reflex.Test.Micro (testCases) where
10import Reflex
11import Reflex.TestPlan
13import Control.Applicative
14import Control.Monad
15import Data.Char
16import Data.Functor.Misc
17import Data.Monoid
19import Data.Foldable
21import qualified Data.Map as Map
23import Prelude
25testCases :: [(String, TestCase)]
26testCases =
27 [ testB "hold" $ hold "0" =<< events1
29 , testB "count" $ do
30 b <- current <$> (count =<< events2)
31 return $ (+ (0::Int)) <$> b
33 , testB "pull-1" $ do
34 b <- hold "0" =<< events1
35 return (pull $ sample $ pull $ sample b)
37 , testB "pull-2" $ do
38 b1 <- behavior1
39 return (pull $ liftA2 (<>) (sample b1) (sample b1))
41 , testB "pull-3" $ do
42 b1 <- behavior1
43 b2 <- behavior2
44 return (pull $ liftA2 (<>) (sample b1) (sample b2))
46 , testB "pull-4" $ do
47 es <- planList ["a", "b", "c"]
48 e <- plan [(0, ())]
49 b <- hold (constant "") $
50 pushAlways (const $ hold "z" es) e
51 return (join b)
53 , testE "tag-1" $ do
54 b1 <- behavior1
55 e <- events2
56 return (tag b1 e)
58 , testE "tag-2" $ do
59 b1 <- behavior1
60 e <- events2
61 return (tag (map toUpper <$> b1) e)
63 , testE "attach-1" $ do
64 b1 <- behavior1
65 e <- events2
66 return (attachWith (++) (map toUpper <$> b1) e)
68 , testE "leftmost" $ liftA2 leftmost2 events1 events2
70 , testE "appendEvents-1" $ liftA2 mappend events1 events2
72 , testE "appendEvents-2" $ liftA2 mappend events3 events2
74 , testE "merge-1" $ do
75 e <- events1
76 return $ leftmost ["x" <$ e, "y" <$ e]
78 , testE "merge-2" $ do
79 e <- events1
80 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 "headE-1" $ do
85 e <- events1
86 headE $ leftmost [e, e]
88 , testE "headE-2" $ do
89 e <- events1
90 b <- hold never (e <$ e)
91 headE $ switch b
93 , testE "switch-1" $ do
94 e <- events1
95 b <- hold never (e <$ e)
96 return $ switch b
98 , testE "switch-2" $ do
99 e <- events1
100 return $ coincidence $ flip pushAlways e $ const $ do
101 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) (e <$ e)
103 , testE "switch-3" $ do
104 e <- events1
105 return $ coincidence $ flip pushAlways e $ const $ do
106 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) never
108 , testE "switch-4" $ do
109 e <- events1
110 switch <$> hold (deep e) (e <$ e)
112 , testE "switch-5" $ do
113 e <- events1
114 return $ coincidence $ flip pushAlways e $ const $
115 return $ leftmost ["x" <$ e, "y" <$ e, "z" <$ e]
117 , testE "switch-6" $ do
118 e <- events1
119 return $ coincidence $ flip pushAlways e $ const $ do
120 switch <$> hold ("x" <$ e) (e <$ e)
122 , testE "switchPromptly-1" $ do
123 e <- events1
124 let e' = e <$ e
125 switchPromptly never $ e <$ e'
127 , testE "switchPromptly-2" $ do
128 e <- events1
129 switchPromptly never $ deep (e <$ e)
131 , testE "switchPromptly-3" $ do
132 e <- events1
133 switchPromptly never $ (e <$ deep e)
135 , testE "switchPromptly-4" $ do
136 e <- events1
137 switchPromptly never $ (deep e <$ e)
139 , testE "switch-5" $ do
140 e <- events1
141 switch <$> hold never (deep e <$ e)
143 , testE "switchPromptly-5" $ do
144 e <- events1
145 switchPromptly never $ flip push e $
146 const (Just <$> headE e)
148 , testE "switchPromptly-6" $ do
149 e <- events1
150 switchPromptly never $ flip pushAlways e $
151 const (switchPromptly e never)
153 , testE "coincidence-1" $ do
154 e <- events1
155 return $ coincidence $ flip pushAlways e $
156 const $ return e
158 , testE "coincidence-2" $ do
159 e <- events1
160 return $ coincidence $ flip pushAlways e $
161 const $ return (deep e)
163 , testE "coincidence-3" $ do
164 e <- events1
165 return $ coincidence $ flip pushAlways e $
166 const $ return (coincidence (e <$ e))
168 , testE "coincidence-4" $ do
169 e <- events1
170 return $ coincidence $ flip pushAlways e $
171 const (headE e)
173 , testE "coincidence-5" $ do
174 e <- events1
175 return $ coincidence $ flip pushAlways e $ const $ do
176 let e' = deep e
177 return (coincidence (e' <$ e'))
179 , testE "coincidence-6" $ do
180 e <- events1
181 return $ coincidence $ flip pushAlways e $ const $ do
182 let e' = coincidence (e <$ e)
183 return $ deep e'
185 , testE "coincidence-7" $ do
186 e <- events1
187 return $ coincidence (deep e <$ e)
189 , testB "holdWhileFiring" $ do
190 e <- events1
191 eo <- headE e
192 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
193 return $ pull $ sample =<< sample bb
195 , testE "joinDyn" $ do
196 e <- events1
197 bb <- hold "b" e
198 bd <- hold never . fmap (const e) =<< headE e
200 eOuter <- pushAlways sample . fmap (const bb) <$> headE e
201 let eInner = switch bd
202 return $ leftmost [eOuter, eInner]
204 , testB "foldDyn" $ do
205 d <- foldDyn (++) "0" =<< events1
206 return (current d)
208 , testB "mapDyn" $ do
209 d <- foldDyn (++) "0" =<< events1
210 return $ current $ fmap (map toUpper) d
212 , testB "combineDyn" $ do
213 d1 <- foldDyn (++) "0" =<< events1
214 d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2
216 return $ current $ zipDynWith (<>) d1 d2
217 , testE "fan-1" $ do
218 e <- fmap toMap <$> events1
219 let es = select (fanMap e) . Const2 <$> values
221 return (mergeList es)
223 , testE "fan-2" $ do
224 e <- fmap toMap <$> events3
225 let es = select (fanMap e) . Const2 <$> values
227 return (mergeList es)
229 , testE "fan-3" $ do
230 f <- fanMap . fmap toMap <$> events3
231 return $ select f (Const2 'c')
233 , testE "fan-4" $ do
234 e <- fmap toMap <$> events1
235 return $ toUpper <$> select (fanMap e) (Const2 'a')
237 , testE "fan-5" $ do
238 e <- fmap toMap <$> events2
239 return $ toUpper <$> select (fanMap e) (Const2 'c')
241 , testE "fan-6" $ do
242 f <- fanMap . fmap toMap <$> events1
243 return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]
245 ] where
247 events1, events2, events3 :: TestPlan t m => m (Event t String)
248 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
249 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
251 events3 = liftA2 mappend events1 events2
253 values = "abcde"
254 toMap str = Map.fromList $ map (\c -> (c, c)) str
256 behavior1, behavior2 :: forall t m. TestPlan t m => m (Behavior t String)
257 behavior1 = hold "1" =<< events1
258 behavior2 = hold "2" =<< events2
260 deep e = leftmost [e, e]
261 leftmost2 e1 e2 = leftmost [e1, e2]