module Reactive.Banana.Tests where
import Control.Monad (when)
import Reactive.Banana.Model as Model
import Reactive.Banana.Implementation as Impl
import Test.QuickCheck
matchesModel :: (Typeable a, Show b, Eq b) =>
(forall f. FRP f => Event f a -> Event f b) -> [a] -> IO Bool
matchesModel f = \xs -> do
let bs1 = Model.interpret f xs
bs2 <- Impl.interpret f xs
when (bs1 /= bs2) $ print bs1 >> print bs2
return $ bs1 == bs2
testSuite = do
test add1
test filtering
test counter
test double
test sharing
test decrease
test accumBvsE
where
test :: (Show b, Eq b) => (forall f. FRP f => Event f Int -> Event f b)
-> IO ()
test f = print =<< matchesModel f [1..8::Int]
test f = Impl.interpret f [1..8::Int]
add1 = fmap (+1)
filtering = filterE (>= 3) . fmap (subtract 1)
counter e = apply (pure const <*> bcounter) e
where bcounter = accumB 0 $ fmap (\_ -> (+1)) e
double e = union e e
sharing e = union e1 e1
where e1 = filterE (< 3) e
type Dummy = Int
decrease :: FRP f => Event f Dummy -> Event f Int
decrease edec = apply (const <$> bcounter) ecandecrease
where
bcounter = accumB 4 $ (subtract 1) <$ ecandecrease
ecandecrease = whenE ((>0) <$> bcounter) edec
accumBvsE :: FRP f => Event f Dummy -> Event f Int
accumBvsE input = e1 `union` e2
where
e = input `union` input
e1 = accumE 0 ((+1) <$ e)
e2 = let b = accumB 0 ((+1) <$ e) in apply (const <$> b) e