4e4600f · reflex · git.iko.soy

git.iko.soy/reflex

Abstract out test running code

commit4e4600f7ff6d49a702a4d9bcfaa5018692441254 authorDan Haraj <dan@obsidian.systems> dateFri 2 Jun 2017, 18:11 (9 years ago) parent13e71e8

3 files changed+48−51

compare with develop

unifiedsplit

test/EventWriterT.hs+4−25 test/RequesterT.hs+11−26 test/Test/Run.hs+33

test/EventWriterT.hs+4−25

@@ -13,42 +13,21 @@ import Reflex

1313import Reflex.EventWriter

1414import Reflex.Host.Class

1515import Reflex.PerformEvent.Base

16+import Test.Run

1617

1718import System.Exit (exitFailure)

1819

20+

1921main :: IO ()

2022main = do

21− (Just out1, Nothing) <- runApp app1

23+ (Just out1, Nothing) <- runApp $ runEventWriterT . app1

2224 print out1

23− (Just out2, Just (out3, out4)) <- runApp app2

25+ (Just out2, Just (out3, out4)) <- runApp $ runEventWriterT . app2

2426 print out2

2527 print out3

2628 print out4

2729 when (sort out1 /= out1 || map (+1) out2 /= out3 || out3 /= out4) exitFailure

2830

29−runApp :: (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]))

32−runApp 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)

51−

5231app1 :: (Reflex t, Ref m ~ IORef, EventWriter t [Int] m) => Event t () -> m (Maybe (Ref m (Maybe (EventTrigger t ()))))

5332app1 e = do

5433 forM_ [1..10] $ \i -> tellEvent ([i] <$ e)

test/RequesterT.hs+11−26

@@ -1,4 +1,4 @@

1−{-# LANGUAGE FlexibleContexts, GADTs #-}

1+{-# LANGUAGE FlexibleContexts, GADTs, RankNTypes, ScopedTypeVariables #-}

22module Main where

44import Control.Monad

@@ -15,6 +15,7 @@ import Reflex.Host.Class

1515import Reflex.PerformEvent.Base

1616import Reflex.Requester.Base

1717import Reflex.Requester.Class

18+import Test.Run

1819

1920import System.Exit (exitFailure, exitSuccess)

2021

@@ -23,40 +24,24 @@ data RequestInt a where

2324

2425main :: IO ()

2526main = do

26− (Just out1, Nothing) <- runApp app1

27+ (Just out1, Nothing) <- runApp $ unwrapApp app1

2728 print out1

28− (Just out2, Just (out3, out4)) <- runApp app2

29+ (Just out2, Just (out3, out4)) <- runApp $ unwrapApp app2

2930 print out2

3031 print out3

3132 print out4

3233 when (sort out1 /= out1 || map (+1) out2 /= out3 || out3 /= out4) exitFailure

3334

34−runApp :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)

35− => (Event t () -> RequesterT t RequestInt Identity (PerformEventT t m) (Maybe (Ref m (Maybe (EventTrigger t ())))))

36− -> IO (Maybe [Int], Maybe ([Int], [Int]))

37−runApp x = runSpiderHost $ do

38− (pulseE, pulseTriggerRef) <- newEventWithTriggerRef

39− ((mactuateRef, e), FireCommand fire) <- hostPerformEventT $ runRequesterT (x pulseE) never

40− hnd <- subscribeEvent (map unwrapRequest . DMap.toList <$> e)

41− out1 <- fireEventRefAndRead pulseTriggerRef () hnd

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

43− let readPhase = do

44− mGetValue <- readEvent hnd

45− case mGetValue of

46− Nothing -> return Nothing

47− Just getValue -> fmap Just getValue

48− mactuate <- readRef actuateRef

49− mpulse <- readRef pulseTriggerRef

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

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

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

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

54− return (a,b)

55− return (out1, out2)

56−

5735unwrapRequest :: DSum tag RequestInt -> Int

5836unwrapRequest (_ :=> RequestInt i) = i

5937

38+unwrapApp :: forall x t a response. (Reflex t, ReflexHost t)

39+ => (x -> RequesterT t RequestInt response (PerformEventT t (SpiderHost Global)) a)

40+ -> x -> PerformEventT t (SpiderHost Global) (a, Event t [Int])

41+unwrapApp x e = do

42+ (a, b) <- runRequesterT (x e) never

43+ return (a, fmap (map unwrapRequest . DMap.toList) b)

44+

6045app1 :: (Reflex t, Ref m ~ IORef, Requester t m, Response m ~ Identity, Request m ~ RequestInt) => Event t () -> m (Maybe (Ref m (Maybe (EventTrigger t ()))))

6146app1 e = do

6247 forM_ [1..10] $ \i -> requestingIdentity (RequestInt i <$ e)

test/Test/Run.hsnew file+33

@@ -0,0 +1,33 @@

1+{-# LANGUAGE GADTs #-}

2+module Test.Run where

4+import Control.Monad

5+import Control.Monad.Ref

6+import Data.Dependent.Sum

7+import Data.Functor.Identity

9+import Reflex

10+import Reflex.Host.Class

11+

12+runApp :: (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))

15+runApp 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)