e7ff6ed · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

rearchitect test runner

e7ff6edDan Haraj9 years ago

reflex.cabal+4

compare with develop

unifiedsplit

@@ -189,6 +189,8 @@ test-suite EventWriterT

189 hs-source-dirs: test

190 build-depends: base

191 , dependent-sum

192+ , lens

193+ , these

192 , transformers

194 , transformers

193 , reflex

195 , reflex

194 , ref-tf

196 , ref-tf

@@ -200,6 +202,8 @@ test-suite RequesterT

200 build-depends: base

202 build-depends: base

201 , dependent-sum

203 , dependent-sum

202 , dependent-map

204 , dependent-map

205+ , lens

206+ , these

203 , transformers

207 , transformers

204 , reflex

208 , reflex

205 , ref-tf

209 , ref-tf

test/EventWriterT.hs+37−26

@@ -1,40 +1,51 @@

1{-# LANGUAGE FlexibleContexts, GADTs #-}

2module Main where

4+import Control.Lens

4import Control.Monad

5import Control.Monad

5−import Control.Monad.IO.Class

6+import Data.These

6−import Control.Monad.Ref

7−import Data.Dependent.Sum

8−import Data.IORef

9−import Data.List

10−import Data.Functor.Identity

12import Reflex

8import Reflex

13import Reflex.EventWriter

9import Reflex.EventWriter

14−import Reflex.Host.Class

15−import Reflex.PerformEvent.Base

16import Test.Run

10import Test.Run

18import System.Exit (exitFailure)

12import System.Exit (exitFailure)

14+import Data.IORef

15+import Control.Monad.Ref

16+import Reflex.Host.Class

17+import Data.List

21main :: IO ()

19main :: IO ()

22main = do

20main = do

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

21+ os1@[[Just [10,9,8,7,6,5,4,3,2,1]]] <- runApp' (unwrapApp app1) $

22+ [ Just ()

23+ ]

24− print out1

24+ print os1

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

25+ os2@[[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]]

26− print out2

26+ <- runApp' (unwrapApp app2) $ map Just $

27− print out3

27+ [ This ()

28− print out4

28+ , That ()

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

29+ , This ()

30−

30+ , These () ()

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

31+ ]

32+ print os2

33+ return ()

34+

35+unwrapApp :: (Reflex t, Monad m) => (a -> EventWriterT t [Int] m ()) -> a -> m (Event t [Int])

36+unwrapApp x appIn = do

37+ ((), e) <- runEventWriterT $ x appIn

38+ return e

39+

40+app1 :: (Reflex t, Monad m) => Event t () -> EventWriterT t [Int] m ()

32−app1 e = do

41+app1 pulse = do

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

42+ forM_ [10,9..1] $ \i -> tellEvent ([i] <$ pulse)

34− return Nothing

43+ return ()

35−

44+

36−app2 :: (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 ()))))

45+app2 :: (Reflex t, MonadAdjust t m, MonadHold t m) => Event t (These () ()) -> EventWriterT t [Int] m ()

37−app2 e = do

46+app2 pulse = do

38− (pulse, pulseTriggerRef) <- newEventWithTriggerRef

47+ let e0 = fmapMaybe (^? here) pulse

48+ e1 = fmapMaybe (^? there) pulse

39− forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e)) $ ffor pulse $ \_ -> tellEvent ([i+1] <$ e)

49+ forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)

40− return (Just pulseTriggerRef)

50+ return ()

51+

test/RequesterT.hs+7

@@ -22,6 +22,12 @@ import System.Exit (exitFailure, exitSuccess)

22data RequestInt a where

23 RequestInt :: Int -> RequestInt Int

25+main :: IO ()

26+main = do

27+ return ()

28+

29+{-

30+

25main :: IO ()

31main :: IO ()

26main = do

32main = do

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

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

@@ -53,3 +59,4 @@ app2 e = do

53 forM_ [1,3..9] $ \i -> runWithReplace (requestingIdentity (RequestInt i <$ e)) $ ffor pulse $ \_ -> requestingIdentity (RequestInt (i+1) <$ e)

59 forM_ [1,3..9] $ \i -> runWithReplace (requestingIdentity (RequestInt i <$ e)) $ ffor pulse $ \_ -> requestingIdentity (RequestInt (i+1) <$ e)

54 return (Just pulseTriggerRef)

60 return (Just pulseTriggerRef)

62+-}

test/Test/Run.hs+55−22

@@ -1,33 +1,66 @@

1{-# LANGUAGE GADTs #-}

2+{-# LANGUAGE LambdaCase #-}

2module Test.Run where

3module Test.Run where

4import Control.Monad

5import Control.Monad

5import Control.Monad.Ref

6import Control.Monad.Ref

6import Data.Dependent.Sum

7import Data.Dependent.Sum

7import Data.Functor.Identity

8import Data.Functor.Identity

9+import Data.These

9import Reflex

11import Reflex

10import Reflex.Host.Class

12import Reflex.Host.Class

14+data AppIn t b e = AppIn

15+ { _appIn_behavior :: Behavior t b

16+ , _appIn_event :: Event t e

17+ }

18+

19+data AppOut t b e = AppOut

20+ { _appOut_behavior :: Behavior t b

21+ , _appOut_event :: Event t e

22+ }

23+

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

24+runApp :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)

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

25+ => (AppIn t bIn eIn -> PerformEventT t m (AppOut t bOut eOut))

26+ -> bIn

27+ -> [Maybe (These bIn eIn)]

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

28+ -> IO [[(bOut, Maybe eOut)]]

15−runApp x = runSpiderHost $ do

29+runApp app b0 input = runSpiderHost $ do

16− (pulseE, pulseTriggerRef) <- newEventWithTriggerRef

30+ (appInHoldE, pulseHoldTriggerRef) <- newEventWithTriggerRef

31+ (appInE, pulseEventTriggerRef) <- newEventWithTriggerRef

32+ appInB <- hold b0 appInHoldE

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

33+ (out, FireCommand fire) <- hostPerformEventT $ app $ AppIn

34+ { _appIn_event = appInE

35+ , _appIn_behavior = appInB

36+ }

18− hnd <- subscribeEvent e

37+ hnd <- subscribeEvent (_appOut_event out)

19− out1 <- fireEventRefAndRead pulseTriggerRef () hnd

38+ mpulseB <- readRef pulseHoldTriggerRef

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

39+ mpulseE <- readRef pulseEventTriggerRef

21− let readPhase = do

40+ let readPhase = do

41+ b <- sample (_appOut_behavior out)

22− mGetValue <- readEvent hnd

42+ frames <- sequence =<< readEvent hnd

23− case mGetValue of

43+ return (b, frames)

24− Nothing -> return Nothing

44+ forM input $ \case

25− Just getValue -> fmap Just getValue

45+ Nothing ->

26− mactuate <- readRef actuateRef

46+ fire [] $ readPhase

27− mpulse <- readRef pulseTriggerRef

47+ Just i -> case i of

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

48+ This b' -> case mpulseB of

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

49+ Nothing -> error "tried to fire in-behavior but ref was empty"

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

50+ Just pulseB -> fire [ pulseB :=> Identity b' ] $ readPhase

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

51+ That e' -> case mpulseE of

32− return (a,b)

52+ Nothing -> error "tried to fire in-event but ref was empty"

33− return (out1, out2)

53+ Just pulseE -> fire [ pulseE :=> Identity e' ] $ readPhase

54+ These b' e' -> case mpulseB of

55+ Nothing -> error "tried to fire in-behavior but ref was empty"

56+ Just pulseB -> case mpulseE of

57+ Nothing -> error "tried to fire in-event but ref was empty"

58+ Just pulseE -> fire [ pulseB :=> Identity b', pulseE :=> Identity e' ] $ readPhase

59+

60+runApp' :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)

61+ => (Event t eIn -> PerformEventT t m (Event t eOut))

62+ -> [Maybe eIn]

63+ -> IO [[Maybe eOut]]

64+runApp' app input = do

65+ let app' = fmap (AppOut (pure ())) . app

66+ map (map snd) <$> runApp (app' . _appIn_event) () (map (fmap That) input)