test/Test/Run.hs · patch

on ef4da28 help sign in

patch/test/Test/Run.hs

33 lines 1.2 kB history raw

1{-# LANGUAGE GADTs #-}

2module Test.Run where

4import Control.Monad

5import Control.Monad.Ref

6import Data.Dependent.Sum

7import Data.Functor.Identity

9import Reflex

10import Reflex.Host.Class

12runApp :: (Show a, t ~ SpiderTimeline Global, m ~ SpiderHost Global)

13 => (Event t () -> PerformEventT t m (Maybe (Ref m (Maybe (EventTrigger t ()))), Event t a))

14 -> IO (Maybe a, Maybe (a, a))

15runApp x = runSpiderHost $ do

16 (pulseE, pulseTriggerRef) <- newEventWithTriggerRef

17 ((mactuateRef, e), FireCommand fire) <- hostPerformEventT $ x pulseE

18 hnd <- subscribeEvent e

19 out1 <- fireEventRefAndRead pulseTriggerRef () hnd

20 out2 <- fmap join $ forM mactuateRef $ \actuateRef -> do

21 let readPhase = do

22 mGetValue <- readEvent hnd

23 case mGetValue of

24 Nothing -> return Nothing

25 Just getValue -> fmap Just getValue

26 mactuate <- readRef actuateRef

27 mpulse <- readRef pulseTriggerRef

28 forM ((,) <$> mactuate <*> mpulse) $ \(actuate, pulse) -> do

29 _ <- fire [actuate :=> Identity ()] $ return ()

30 [Just a] <- fire [pulse :=> Identity ()] $ readPhase

31 [Just b, Nothing] <- fire [actuate :=> Identity (), pulse :=> Identity ()] $ readPhase

32 return (a,b)

33 return (out1, out2)