{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
{-# LANGUAGE RecursiveDo #-}
module Reactive.Banana.Prim.Mid.Test where

import Reactive.Banana.Prim.Mid

main :: IO ()
main :: IO ()
main = IO ()
test_space1

{-----------------------------------------------------------------------------
    Functionality tests
------------------------------------------------------------------------------}
test_accumL1 :: Pulse Int -> BuildIO (Pulse Int)
test_accumL1 :: Pulse Int -> BuildIO (Pulse Int)
test_accumL1 Pulse Int
p1 = BuildIO (Pulse Int) -> BuildIO (Pulse Int)
forall a. Build a -> Build a
liftBuild (BuildIO (Pulse Int) -> BuildIO (Pulse Int))
-> BuildIO (Pulse Int) -> BuildIO (Pulse Int)
forall a b. (a -> b) -> a -> b
$ do
    Pulse (Int -> Int)
p2     <- (Int -> Int -> Int) -> Pulse Int -> Build (Pulse (Int -> Int))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
mapP Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Pulse Int
p1
    (Latch Int
l1,Pulse Int
_) <- Int -> Pulse (Int -> Int) -> Build (Latch Int, Pulse Int)
forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
accumL Int
0 Pulse (Int -> Int)
p2
    let l2 :: Latch (b -> Int)
l2 =  (Int -> b -> Int) -> Latch Int -> Latch (b -> Int)
forall a b. (a -> b) -> Latch a -> Latch b
mapL Int -> b -> Int
forall a b. a -> b -> a
const Latch Int
l1
    Latch (Int -> Int) -> Pulse Int -> BuildIO (Pulse Int)
forall a b. Latch (a -> b) -> Pulse a -> Build (Pulse b)
applyP Latch (Int -> Int)
forall {b}. Latch (b -> Int)
l2 Pulse Int
p1

test_recursion1 :: Pulse () -> BuildIO (Pulse Int)
test_recursion1 :: Pulse () -> BuildIO (Pulse Int)
test_recursion1 Pulse ()
p1 = BuildIO (Pulse Int) -> BuildIO (Pulse Int)
forall a. Build a -> Build a
liftBuild (BuildIO (Pulse Int) -> BuildIO (Pulse Int))
-> BuildIO (Pulse Int) -> BuildIO (Pulse Int)
forall a b. (a -> b) -> a -> b
$ mdo
    Pulse Int
p2      <- Latch (() -> Int) -> Pulse () -> BuildIO (Pulse Int)
forall a b. Latch (a -> b) -> Pulse a -> Build (Pulse b)
applyP Latch (() -> Int)
l2 Pulse ()
p1
    Pulse (Int -> Int)
p3      <- (Int -> Int -> Int) -> Pulse Int -> Build (Pulse (Int -> Int))
forall a b. (a -> b) -> Pulse a -> Build (Pulse b)
mapP ((Int -> Int) -> Int -> Int -> Int
forall a b. a -> b -> a
const (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Pulse Int
p2
    ~(Latch Int
l1,Pulse Int
_) <- Int -> Pulse (Int -> Int) -> Build (Latch Int, Pulse Int)
forall a. a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
accumL (Int
0::Int) Pulse (Int -> Int)
p3
    let l2 :: Latch (b -> Int)
l2  =  (Int -> b -> Int) -> Latch Int -> Latch (b -> Int)
forall a b. (a -> b) -> Latch a -> Latch b
mapL Int -> b -> Int
forall a b. a -> b -> a
const Latch Int
l1
    Pulse Int -> BuildIO (Pulse Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Pulse Int
p2

-- test garbage collection

{-----------------------------------------------------------------------------
    Space leak tests
------------------------------------------------------------------------------}
test_space1 :: IO ()
test_space1 :: IO ()
test_space1 = (Pulse Int -> BuildIO (Pulse Int)) -> [Int] -> IO ()
forall b a.
Show b =>
(Pulse a -> BuildIO (Pulse b)) -> [a] -> IO ()
runSpaceProfile Pulse Int -> BuildIO (Pulse Int)
test_accumL1 [Int
1::Int .. Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
4 :: Int)]

test_space2 :: IO ()
test_space2 :: IO ()
test_space2 = (Pulse () -> BuildIO (Pulse Int)) -> [()] -> IO ()
forall b a.
Show b =>
(Pulse a -> BuildIO (Pulse b)) -> [a] -> IO ()
runSpaceProfile Pulse () -> BuildIO (Pulse Int)
test_recursion1 ([()] -> IO ()) -> [()] -> IO ()
forall a b. (a -> b) -> a -> b
$ () () -> [Int] -> [()]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Int
1::Int .. Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
4 :: Int)]