git.iko.soy/patch
on d964a67 help sign in
patch/test/Reflex/Test/Micro.hs
279 lines 7.4 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RecursiveDo #-}
10module Reflex.Test.Micro (testCases) where
12import Reflex
13import Reflex.TestPlan
15import Control.Applicative
16import Control.Monad
17import Control.Monad.Fix
18import Data.Char
19import Data.Foldable
20import Data.Functor.Misc
21import qualified Data.Map as Map
22import Data.Monoid
24import Prelude
26testCases :: [(String, TestCase)]
27testCases =
28 [ testB "hold" $ hold "0" =<< events1
30 , testB "count" $ do
31 b <- current <$> (count =<< events2)
32 return $ (+ (0::Int)) <$> b
34 , testB "pull-1" $ do
35 b <- hold "0" =<< events1
36 return (pull $ sample $ pull $ sample b)
38 , testB "pull-2" $ do
39 b1 <- behavior1
40 return (pull $ liftA2 (<>) (sample b1) (sample b1))
42 , testB "pull-3" $ do
43 b1 <- behavior1
44 b2 <- behavior2
45 return (pull $ liftA2 (<>) (sample b1) (sample b2))
47 , testB "pull-4" $ do
48 es <- planList ["a", "b", "c"]
49 e <- plan [(0, ())]
50 b <- hold (constant "") $
51 pushAlways (const $ hold "z" es) e
52 return (join b)
54 , testE "id" $ do
55 events2
57 , testE "fmap-id" $ do
58 e <- events2
59 return $ fmap id e
61 , testE "tag-1" $ do
62 b1 <- behavior1
63 e <- events2
64 return (tag b1 e)
66 , testE "tag-2" $ do
67 b1 <- behavior1
68 e <- events2
69 return (tag (map toUpper <$> b1) e)
71 , testE "attach-1" $ do
72 b1 <- behavior1
73 e <- events2
74 return (attachWith (++) (map toUpper <$> b1) e)
76 , testE "leftmost" $ liftA2 leftmost2 events1 events2
78 , testE "appendEvents-1" $ liftA2 mappend events1 events2
80 , testE "appendEvents-2" $ liftA2 mappend events3 events2
82 , testE "merge-1" $ do
83 e <- events1
84 return $ leftmost ["x" <$ e, "y" <$ e]
86 , testE "merge-2" $ do
87 e <- events1
88 let m = mergeMap $ Map.fromList [(1::Int, "y" <$ e), (2, "z" <$ e)]
89 let ee = flip pushAlways e $ const $ return m
90 return $ coincidence ee
92 , testE "headE-1" $ do
93 e <- events1
94 headE $ leftmost [e, e]
96 , testE "headE-2" $ do
97 e <- events1
98 b <- hold never (e <$ e)
99 headE $ switch b
101 , testE "switch-1" $ do
102 e <- events1
103 b <- hold never (e <$ e)
104 return $ switch b
106 , testE "switch-2" $ do
107 e <- events1
108 return $ coincidence $ flip pushAlways e $ const $ do
109 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) (e <$ e)
111 , testE "switch-3" $ do
112 e <- events1
113 return $ coincidence $ flip pushAlways e $ const $ do
114 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) never
116 , testE "switch-4" $ do
117 e <- events1
118 switch <$> hold (deep e) (e <$ e)
120 , testE "switch-5" $ do
121 e <- events1
122 return $ coincidence $ flip pushAlways e $ const $
123 return $ leftmost ["x" <$ e, "y" <$ e, "z" <$ e]
125 , testE "switch-6" $ do
126 e <- events1
127 return $ coincidence $ flip pushAlways e $ const $ do
128 switch <$> hold ("x" <$ e) (e <$ e)
130 , testE "switchPromptly-1" $ do
131 e <- events1
132 let e' = e <$ e
133 switchPromptly never $ e <$ e'
135 , testE "switchPromptly-2" $ do
136 e <- events1
137 switchPromptly never $ deep (e <$ e)
139 , testE "switchPromptly-3" $ do
140 e <- events1
141 switchPromptly never $ (e <$ deep e)
143 , testE "switchPromptly-4" $ do
144 e <- events1
145 switchPromptly never $ (deep e <$ e)
147 , testE "switch-5" $ do
148 e <- events1
149 switch <$> hold never (deep e <$ e)
151 , testE "switchPromptly-5" $ do
152 e <- events1
153 switchPromptly never $ flip push e $
154 const (Just <$> headE e)
156 , testE "switchPromptly-6" $ do
157 e <- events1
158 switchPromptly never $ flip pushAlways e $
159 const (switchPromptly e never)
161 , testE "coincidence-1" $ do
162 e <- events1
163 return $ coincidence $ flip pushAlways e $
164 const $ return e
166 , testE "coincidence-2" $ do
167 e <- events1
168 return $ coincidence $ flip pushAlways e $
169 const $ return (deep e)
171 , testE "coincidence-3" $ do
172 e <- events1
173 return $ coincidence $ flip pushAlways e $
174 const $ return (coincidence (e <$ e))
176 , testE "coincidence-4" $ do
177 e <- events1
178 return $ coincidence $ flip pushAlways e $
179 const (headE e)
181 , testE "coincidence-5" $ do
182 e <- events1
183 return $ coincidence $ flip pushAlways e $ const $ do
184 let e' = deep e
185 return (coincidence (e' <$ e'))
187 , testE "coincidence-6" $ do
188 e <- events1
189 return $ coincidence $ flip pushAlways e $ const $ do
190 let e' = coincidence (e <$ e)
191 return $ deep e'
193 , testE "coincidence-7" $ do
194 e <- events1
195 return $ coincidence (deep e <$ e)
197 , testB "holdWhileFiring" $ do
198 e <- events1
199 eo <- headE e
200 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
201 return $ pull $ sample =<< sample bb
203 , testE "joinDyn" $ do
204 e <- events1
205 bb <- hold "b" e
206 bd <- hold never . fmap (const e) =<< headE e
208 eOuter <- pushAlways sample . fmap (const bb) <$> headE e
209 let eInner = switch bd
210 return $ leftmost [eOuter, eInner]
212 , testB "foldDyn" $ do
213 d <- foldDyn (++) "0" =<< events1
214 return (current d)
216 , testB "mapDyn" $ do
217 d <- foldDyn (++) "0" =<< events1
218 return $ current $ fmap (map toUpper) d
220 , testB "combineDyn" $ do
221 d1 <- foldDyn (++) "0" =<< events1
222 d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2
224 return $ current $ zipDynWith (<>) d1 d2
225 , testE "fan-1" $ do
226 e <- fmap toMap <$> events1
227 let es = select (fanMap e) . Const2 <$> values
229 return (mergeList es)
231 , testE "fan-2" $ do
232 e <- fmap toMap <$> events3
233 let es = select (fanMap e) . Const2 <$> values
235 return (mergeList es)
237 , testE "fan-3" $ do
238 f <- fanMap . fmap toMap <$> events3
239 return $ select f (Const2 'c')
241 , testE "fan-4" $ do
242 e <- fmap toMap <$> events1
243 return $ toUpper <$> select (fanMap e) (Const2 'a')
245 , testE "fan-5" $ do
246 e <- fmap toMap <$> events2
247 return $ toUpper <$> select (fanMap e) (Const2 'c')
249 , testE "fan-6" $ do
250 f <- fanMap . fmap toMap <$> events1
251 return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]
253 , testE "lazy-hold" $ do
254 let lazyHold :: forall t m. (Reflex t, MonadHold t m, MonadFix m) => m (Event t ())
255 lazyHold = do
256 rec !b <- hold never e
257 let e = never <$ switch b
258 return $ void e
259 lazyHold
261 ] where
263 events1, events2, events3 :: TestPlan t m => m (Event t String)
264 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
265 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
267 events3 = liftA2 mappend events1 events2
269 values = "abcde"
270 toMap str = Map.fromList $ map (\c -> (c, c)) str
272 behavior1, behavior2 :: forall t m. TestPlan t m => m (Behavior t String)
273 behavior1 = hold "1" =<< events1
274 behavior2 = hold "2" =<< events2
276 deep e = leftmost [e, e]
277 leftmost2 e1 e2 = leftmost [e1, e2]