4e4600f · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Abstract out test running code

4e4600fDan Haraj9 years ago

test/EventWriterT.hs+4−25

compare with develop

unifiedsplit

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

13import Reflex.EventWriter

14import Reflex.Host.Class

15import Reflex.PerformEvent.Base

16+import Test.Run

17import System.Exit (exitFailure)

18import System.Exit (exitFailure)

20+

19main :: IO ()

21main :: IO ()

20main = do

22main = do

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

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

22 print out1

24 print out1

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

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

24 print out2

26 print out2

25 print out3

27 print out3

26 print out4

28 print out4

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

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

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−

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

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

53app1 e = do

32app1 e = do

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

33 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 #-}

2module Main where

4import Control.Monad

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

15import Reflex.PerformEvent.Base

16import Reflex.Requester.Base

17import Reflex.Requester.Class

18+import Test.Run

19import System.Exit (exitFailure, exitSuccess)

20import System.Exit (exitFailure, exitSuccess)

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

24main :: IO ()

25main :: IO ()

25main = do

26main = do

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

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

27 print out1

28 print out1

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

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

29 print out2

30 print out2

30 print out3

31 print out3

31 print out4

32 print out4

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

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

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−

57unwrapRequest :: DSum tag RequestInt -> Int

35unwrapRequest :: DSum tag RequestInt -> Int

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

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

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+

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

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

61app1 e = do

46app1 e = do

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

47 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)