on ae@dev-script help sign in
reflex/test/Reflex/Test.hs
66 lines 1.4 kB history raw
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE RankNTypes #-}
8module Reflex.Test
9 ( testAgreement
10 , compareResult
11 , runTests
13 , module Reflex.TestPlan
15 ) where
17import Reflex.Spider
19import Reflex.TestPlan
21import Reflex.Plan.Pure
22import Reflex.Plan.Reflex
24import Control.Monad
25import Data.Monoid
27import Data.IntMap (IntMap)
29--import Data.Foldable
30import System.Exit
32import Prelude
35testAgreement :: TestCase -> IO Bool
36testAgreement (TestE p) = do
37 spider <- runSpiderHost $ runTestE p
38 let results = [("spider", spider)]
40 compareResult results (testEvent $ runPure p)
42testAgreement (TestB p) = do
43 spider <- runSpiderHost $ runTestB p
44 let results = [("spider", spider)]
46 compareResult results (testBehavior $ runPure p)
49compareResult :: (Show a, Eq a) => [(String, IntMap a)] -> IntMap a -> IO Bool
50compareResult results expected = fmap and $ forM results $ \(name, r) -> do
52 when (r /= expected) $ do
53 putStrLn ("Got: " ++ show (name, r))
54 putStrLn ("Expected: " ++ show expected)
55 return (r == expected)
58runTests :: [(String, TestCase)] -> IO ()
59runTests testCases = do
60 results <- forM testCases $ \(name, test) -> do
61 putStrLn $ "Test: " <> name
62 testAgreement test
63 exitWith $ if and results
64 then ExitSuccess
65 else ExitFailure 1