@@ -21,6 +21,7 @@ import Reflex.Dynamic
2121import Reflex.Host.Class
2222import qualified Reflex.Pure as P
2323import qualified Reflex.Spider.Internal as S
24+import qualified Reflex.Profiled as Prof
2425
2526import Control.Arrow (second, (&&&))
2627import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
@@ -73,11 +74,14 @@ instance MapMSignals (Event t a) (Event t' a) t t' where
7374instance (MapMSignals a a' t t', MapMSignals b b' t t') => MapMSignals (a, b) (a', b') t t' where
7475 mapMSignals fb fe (a, b) = liftM2 (,) (mapMSignals fb fe a) (mapMSignals fb fe b)
7576
76−testSpider :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d)) -> (Map Int a, Map Int b) -> (Map Int c, Map Int d)
77−testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do
77+testTimeline
78+ :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d))
79+ -> (Map Int a, Map Int b)
80+ -> (forall m t. (MonadReflexHost t m, MonadIO m, MonadRef m, Ref m ~ Ref IO, MonadSample t m) => m (Map Int c, Map Int d))
81+testTimeline builder (bMap, eMap) = do
7882 (re, reTrigger) <- newEventWithTriggerRef
7983 (rb, rbTrigger) <- newEventWithTriggerRef
80− b <- runHostFrame $ hold (error "testSpider: No value for input behavior yet") rb
84+ b <- runHostFrame $ hold (error "testTimeline: No value for input behavior yet") rb
8185 (b', e') <- runHostFrame $ builder (b, re)
8286 e'Handle <- subscribeEvent e' --TODO: This should be unnecessary
8387 let times = relevantTestingTimes (bMap, eMap)
@@ -102,9 +106,11 @@ testAgreement :: (Eq c, Eq d, Show c, Show d) => (forall m t. TestCaseConstraint
102106testAgreement builder inputs = do
103107 let identityResult = testPure builder inputs
104108 tracePerf "---------" $ return ()
105− let spiderResult = testSpider builder inputs
109+ let spiderResult = unsafePerformIO $ S.runSpiderHost $ testTimeline builder inputs
106110 tracePerf "---------" $ return ()
107− let resultsAgree = identityResult == spiderResult
111+ let profiledResult = unsafePerformIO $ S.runSpiderHost $ Prof.runProfiledM $ testTimeline builder inputs
112+ tracePerf "---------" $ return ()
113+ let resultsAgree = identityResult == spiderResult && identityResult == profiledResult
108114 if resultsAgree
109115 then do --putStrLn "Success:"
110116 --print identityResult
@@ -112,6 +118,7 @@ testAgreement builder inputs = do
112118 else do putStrLn "Failure:"
113119 putStrLn $ "Pure result: " <> show identityResult
114120 putStrLn $ "Spider result: " <> show spiderResult
121+ putStrLn $ "Profiled result: " <> show profiledResult
115122 return resultsAgree
116123
117124type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))