git.iko.soy/patch
on 9f48bbd help sign in
patch/test/Reflex/Test/Micro.hs
285 lines 7.5 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
26{-# ANN testCases "HLint: ignore Functor law" #-}
27testCases :: [(String, TestCase)]
28testCases =
29 [ testB "hold" $ hold "0" =<< events1
31 , testB "count" $ do
32 b <- current <$> (count =<< events2)
33 return $ (+ (0::Int)) <$> b
35 , testB "pull-1" $ do
36 b <- hold "0" =<< events1
37 return (pull $ sample $ pull $ sample b)
39 , testB "pull-2" $ do
40 b1 <- behavior1
41 return (pull $ liftA2 (<>) (sample b1) (sample b1))
43 , testB "pull-3" $ do
44 b1 <- behavior1
45 b2 <- behavior2
46 return (pull $ liftA2 (<>) (sample b1) (sample b2))
48 , testB "pull-4" $ do
49 es <- planList ["a", "b", "c"]
50 e <- plan [(0, ())]
51 b <- hold (constant "") $
52 pushAlways (const $ hold "z" es) e
53 return (join b)
55 , testE "id" $ do
56 events2
58 , testE "fmap-id" $ do
59 e <- events2
60 return $ fmap id e
62 , testE "tag-1" $ do
63 b1 <- behavior1
64 e <- events2
65 return (tag b1 e)
67 , testE "tag-2" $ do
68 b1 <- behavior1
69 e <- events2
70 return (tag (map toUpper <$> b1) e)
72 , testE "attach-1" $ do
73 b1 <- behavior1
74 e <- events2
75 return (attachWith (++) (map toUpper <$> b1) e)
77 , testE "leftmost" $ liftA2 leftmost2 events1 events2
79 , testE "appendEvents-1" $ liftA2 mappend events1 events2
81 , testE "appendEvents-2" $ liftA2 mappend events3 events2
83 , testE "merge-1" $ do
84 e <- events1
85 return $ leftmost ["x" <$ e, "y" <$ e]
87 , testE "merge-2" $ do
88 e <- events1
89 let m = mergeMap $ Map.fromList [(1::Int, "y" <$ e), (2, "z" <$ e)]
90 let ee = flip pushAlways e $ const $ return m
91 return $ coincidence ee
93 , testE "headE-1" $ do
94 e <- events1
95 headE $ leftmost [e, e]
97 , testE "headE-2" $ do
98 e <- events1
99 b <- hold never (e <$ e)
100 headE $ switch b
102 , testE "switch-1" $ do
103 e <- events1
104 b <- hold never (e <$ e)
105 return $ switch b
107 , testE "switch-2" $ do
108 e <- events1
109 return $ coincidence $ flip pushAlways e $ const $ do
110 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) (e <$ e)
112 , testE "switch-3" $ do
113 e <- events1
114 return $ coincidence $ flip pushAlways e $ const $ do
115 switch <$> hold (leftmost ["x" <$ e, "y" <$ e, "z" <$ e]) never
117 , testE "switch-4" $ do
118 e <- events1
119 switch <$> hold (deep e) (e <$ e)
121 , testE "switch-5" $ do
122 e <- events1
123 return $ coincidence $ flip pushAlways e $ const $
124 return $ leftmost ["x" <$ e, "y" <$ e, "z" <$ e]
126 , testE "switch-6" $ do
127 e <- events1
128 return $ coincidence $ flip pushAlways e $ const $ do
129 switch <$> hold ("x" <$ e) (e <$ e)
131 , testE "switchPromptly-1" $ do
132 e <- events1
133 let e' = e <$ e
134 switchPromptly never $ e <$ e'
136 , testE "switchPromptly-2" $ do
137 e <- events1
138 switchPromptly never $ deep (e <$ e)
140 , testE "switchPromptly-3" $ do
141 e <- events1
142 switchPromptly never $ (e <$ deep e)
144 , testE "switchPromptly-4" $ do
145 e <- events1
146 switchPromptly never $ (deep e <$ e)
148 , testE "switch-5" $ do
149 e <- events1
150 switch <$> hold never (deep e <$ e)
152 , testE "switchPromptly-5" $ do
153 e <- events1
154 switchPromptly never $ flip push e $
155 const (Just <$> headE e)
157 , testE "switchPromptly-6" $ do
158 e <- events1
159 switchPromptly never $ flip pushAlways e $
160 const (switchPromptly e never)
162 , testE "coincidence-1" $ do
163 e <- events1
164 return $ coincidence $ flip pushAlways e $
165 const $ return e
167 , testE "coincidence-2" $ do
168 e <- events1
169 return $ coincidence $ flip pushAlways e $
170 const $ return (deep e)
172 , testE "coincidence-3" $ do
173 e <- events1
174 return $ coincidence $ flip pushAlways e $
175 const $ return (coincidence (e <$ e))
177 , testE "coincidence-4" $ do
178 e <- events1
179 return $ coincidence $ flip pushAlways e $
180 const (headE e)
182 , testE "coincidence-5" $ do
183 e <- events1
184 return $ coincidence $ flip pushAlways e $ const $ do
185 let e' = deep e
186 return (coincidence (e' <$ e'))
188 , testE "coincidence-6" $ do
189 e <- events1
190 return $ coincidence $ flip pushAlways e $ const $ do
191 let e' = coincidence (e <$ e)
192 return $ deep e'
194 , testE "coincidence-7" $ do
195 e <- events1
196 return $ coincidence (deep e <$ e)
198 , testB "holdWhileFiring" $ do
199 e <- events1
200 eo <- headE e
201 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
202 return $ pull $ sample =<< sample bb
204 , testE "joinDyn" $ do
205 e <- events1
206 bb <- hold "b" e
207 bd <- hold never . fmap (const e) =<< headE e
209 eOuter <- pushAlways sample . fmap (const bb) <$> headE e
210 let eInner = switch bd
211 return $ leftmost [eOuter, eInner]
213 , testB "foldDyn" $ do
214 d <- foldDyn (++) "0" =<< events1
215 return (current d)
217 , testB "mapDyn" $ do
218 d <- foldDyn (++) "0" =<< events1
219 return $ current $ fmap (map toUpper) d
221 , testB "combineDyn" $ do
222 d1 <- foldDyn (++) "0" =<< events1
223 d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2
225 return $ current $ zipDynWith (<>) d1 d2
226 , testE "fan-1" $ do
227 e <- fmap toMap <$> events1
228 let es = select (fanMap e) . Const2 <$> values
230 return (mergeList es)
232 , testE "fan-2" $ do
233 e <- fmap toMap <$> events3
234 let es = select (fanMap e) . Const2 <$> values
236 return (mergeList es)
238 , testE "fan-3" $ do
239 f <- fanMap . fmap toMap <$> events3
240 return $ select f (Const2 'c')
242 , testE "fan-4" $ do
243 e <- fmap toMap <$> events1
244 return $ toUpper <$> select (fanMap e) (Const2 'a')
246 , testE "fan-5" $ do
247 e <- fmap toMap <$> events2
248 return $ toUpper <$> select (fanMap e) (Const2 'c')
250 , testE "fan-6" $ do
251 f <- fanMap . fmap toMap <$> events1
252 return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]
254 , testE "difference" $ do
255 e1 <- events1
256 e2 <- events2
257 return $ e1 `difference ` e2
259 , testE "lazy-hold" $ do
260 let lazyHold :: forall t m. (Reflex t, MonadHold t m, MonadFix m) => m (Event t ())
261 lazyHold = do
262 rec !b <- hold never e
263 let e = never <$ switch b
264 return $ void e
265 lazyHold
267 ] where
269 events1, events2, events3 :: TestPlan t m => m (Event t String)
270 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
271 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
273 events3 = liftA2 mappend events1 events2
275 values = "abcde"
276 toMap str = Map.fromList $ map (\c -> (c, c)) str
278 behavior1, behavior2 :: forall t m. TestPlan t m => m (Behavior t String)
279 behavior1 = hold "1" =<< events1
280 behavior2 = hold "2" =<< events2
282 deep e = leftmost [e, e]
283 leftmost2 e1 e2 = leftmost [e1, e2]