git.iko.soy/reflex
on update-cabal-prof help sign in
reflex/test/EventWriterT.hs
61 lines 2.3 kB history raw
1{-# LANGUAGE FlexibleContexts, GADTs #-}
2module Main where
4import Control.Monad
5import Control.Monad.IO.Class
6import Control.Monad.Ref
7import Data.Dependent.Sum
8import Data.IORef
9import Data.List
10import Data.Functor.Identity
12import Reflex
13import Reflex.EventWriter
14import Reflex.Host.Class
15import Reflex.PerformEvent.Base
17import System.Exit (exitFailure)
19main :: IO ()
20main = do
21 (Just out1, Nothing) <- runApp app1
22 print out1
23 (Just out2, Just (out3, out4)) <- runApp app2
24 print out2
25 print out3
26 print out4
27 when (sort out1 /= out1 || map (+1) out2 /= out3 || out3 /= out4) exitFailure
29runApp :: (Show a, t ~ SpiderTimeline Global, m ~ SpiderHost Global)
30 => (Event t () -> EventWriterT t [a] (PerformEventT t m) (Maybe (Ref m (Maybe (EventTrigger t ())))))
31 -> IO (Maybe [a], Maybe ([a], [a]))
32runApp x = runSpiderHost $ do
33 (pulseE, pulseTriggerRef) <- newEventWithTriggerRef
34 ((mactuateRef, e), FireCommand fire) <- hostPerformEventT $ runEventWriterT (x pulseE)
35 hnd <- subscribeEvent e
36 out1 <- fireEventRefAndRead pulseTriggerRef () hnd
37 out2 <- fmap join $ forM mactuateRef $ \actuateRef -> do
38 let readPhase = do
39 mGetValue <- readEvent hnd
40 case mGetValue of
41 Nothing -> return Nothing
42 Just getValue -> fmap Just getValue
43 mactuate <- readRef actuateRef
44 mpulse <- readRef pulseTriggerRef
45 forM ((,) <$> mactuate <*> mpulse) $ \(actuate, pulse) -> do
46 _ <- fire [actuate :=> Identity ()] $ return ()
47 [Just a] <- fire [pulse :=> Identity ()] $ readPhase
48 [Just b, Nothing] <- fire [actuate :=> Identity (), pulse :=> Identity ()] $ readPhase
49 return (a,b)
50 return (out1, out2)
52app1 :: (Reflex t, Ref m ~ IORef, EventWriter t [Int] m) => Event t () -> m (Maybe (Ref m (Maybe (EventTrigger t ()))))
53app1 e = do
54 forM_ [1..10] $ \i -> tellEvent ([i] <$ e)
55 return Nothing
57app2 :: (Reflex t, Ref m ~ IORef, EventWriter t [Int] m, MonadAdjust t m, MonadReflexCreateTrigger t m, MonadRef m) => Event t () -> m (Maybe (Ref m (Maybe (EventTrigger t ()))))
58app2 e = do
59 (pulse, pulseTriggerRef) <- newEventWithTriggerRef
60 forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e)) $ ffor pulse $ \_ -> tellEvent ([i+1] <$ e)
61 return (Just pulseTriggerRef)