@@ -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_)
@@ -35,8 +36,6 @@ import Data.Traversable
3536import System.Exit
3637import System.Mem
3738
38−import System.IO.Unsafe
39−
4039mapToPureBehavior :: Map Int a -> Behavior PureReflexDomain a
4140mapToPureBehavior m = P.Behavior $ \t -> case Map.lookupLE t m of
4241 Nothing -> error $ "mapToPureBehavior: no value for time " <> show t
@@ -73,11 +72,14 @@ instance MapMSignals (Event t a) (Event t' a) t t' where
7372instance (MapMSignals a a' t t', MapMSignals b b' t t') => MapMSignals (a, b) (a', b') t t' where
7473 mapMSignals fb fe (a, b) = liftM2 (,) (mapMSignals fb fe a) (mapMSignals fb fe b)
7574
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
75+testTimeline
76+ :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d))
77+ -> (Map Int a, Map Int b)
78+ -> (forall m t. (MonadReflexHost t m, MonadIO m, MonadRef m, Ref m ~ Ref IO, MonadSample t m) => m (Map Int c, Map Int d))
79+testTimeline builder (bMap, eMap) = do
7880 (re, reTrigger) <- newEventWithTriggerRef
7981 (rb, rbTrigger) <- newEventWithTriggerRef
80− b <- runHostFrame $ hold (error "testSpider: No value for input behavior yet") rb
82+ b <- runHostFrame $ hold (error "testTimeline: No value for input behavior yet") rb
8183 (b', e') <- runHostFrame $ builder (b, re)
8284 e'Handle <- subscribeEvent e' --TODO: This should be unnecessary
8385 let times = relevantTestingTimes (bMap, eMap)
@@ -102,9 +104,11 @@ testAgreement :: (Eq c, Eq d, Show c, Show d) => (forall m t. TestCaseConstraint
102104testAgreement builder inputs = do
103105 let identityResult = testPure builder inputs
104106 tracePerf "---------" $ return ()
105− let spiderResult = testSpider builder inputs
107+ spiderResult <- S.runSpiderHost $ testTimeline builder inputs
108+ tracePerf "---------" $ return ()
109+ profiledResult <- S.runSpiderHost $ Prof.runProfiledM $ testTimeline builder inputs
106110 tracePerf "---------" $ return ()
107− let resultsAgree = identityResult == spiderResult
111+ let resultsAgree = identityResult == spiderResult && identityResult == profiledResult
108112 if resultsAgree
109113 then do --putStrLn "Success:"
110114 --print identityResult
@@ -112,6 +116,7 @@ testAgreement builder inputs = do
112116 else do putStrLn "Failure:"
113117 putStrLn $ "Pure result: " <> show identityResult
114118 putStrLn $ "Spider result: " <> show spiderResult
119+ putStrLn $ "Profiled result: " <> show profiledResult
115120 return resultsAgree
116121
117122type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))