git.iko.soy/patch
on bd07448 help sign in
patch/test/EventWriterT.hs
65 lines 2.0 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE RecursiveDo #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4module Main where
6import Control.Lens
7import Control.Monad
8import Control.Monad.Fix
9import Data.These
11import Reflex
12import Reflex.EventWriter.Base
13import Test.Run
15main :: IO ()
16main = do
17 os1@[[Just [10,9,8,7,6,5,4,3,2,1]]] <- runApp' (unwrapApp testOrdering) $
18 [ Just ()
19 ]
20 print os1
21 os2@[[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]]
22 <- runApp' (unwrapApp testSimultaneous) $ map Just $
23 [ This ()
24 , That ()
25 , This ()
26 , These () ()
27 ]
28 print os2
29 os3@[[Nothing, Just [2]]] <- runApp' (unwrapApp testMoribundTellEvent) [Just ()]
30 print os3
31 return ()
33unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])
34unwrapApp x appIn = do
35 ((), e) <- runEventWriterT $ x appIn
36 return e
38testOrdering :: (Reflex t, Monad m) => Event t () -> EventWriterT t [Int] m ()
39testOrdering pulse = do
40 forM_ [10,9..1] $ \i -> tellEvent ([i] <$ pulse)
41 return ()
43testSimultaneous :: (Reflex t, Adjustable t m, MonadHold t m) => Event t (These () ()) -> EventWriterT t [Int] m ()
44testSimultaneous pulse = do
45 let e0 = fmapMaybe (^? here) pulse
46 e1 = fmapMaybe (^? there) pulse
47 forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)
48 return ()
50-- | Test that a widget telling and event which fires at the same time it has been replaced
51-- doesn't count along with the new widget.
52testMoribundTellEvent
53 :: forall t m
54 . ( Reflex t
55 , Adjustable t m
56 , MonadHold t m
57 , MonadFix m
58 )
59 => Event t ()
60 -> EventWriterT t [Int] m ()
61testMoribundTellEvent pulse = do
62 rec let tellIntOnReplce :: Int -> EventWriterT t [Int] m ()
63 tellIntOnReplce x = tellEvent $ [x] <$ rwrFinished
64 (_, rwrFinished) <- runWithReplace (tellIntOnReplce 1) $ tellIntOnReplce 2 <$ pulse
65 return ()