Test.hs

{-# OPTIONS_GHC -fno-warn-tabs #-}  -- Support tab indentation better, for a better default of no warning if tabs are used: https://dmitryfrank.com/articles/indent_with_tabs_align_with_spaces .
-- Enable warnings:
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

-- Test.hs.

{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE Arrows #-}

module Test.Immutaball.Share.Wire.Test
	(
		main,
		testsMain,
		tests,

		myWire,
		dt,
		accumulateThings,
		differentiateThings,
		stepFourTimes,
		stepThrice,
		stepTwice,
		stepOnce,
		waitThenEmit,
		holdingWire,
		queueingWire
	) where

import Control.Arrow
import Data.Functor.Identity

import Test.HUnit
--import Test.QuickCheck
import Test.Tasty
import Test.Tasty.HUnit hiding ((@?=), assertBool)
--import Test.Tasty.QuickCheck

import Immutaball.Share.Wire

main :: IO ()
main = testsMain

testsMain :: IO ()
testsMain = defaultMain tests

myWire :: Wire Identity () Integer
myWire = proc () -> returnA -< 3

dt :: Wire Identity () Integer
dt = proc () -> returnA -< 100

accumulateThings :: Wire Identity () Integer
accumulateThings = proc () -> do
	dt_ <- dt -< ()
	thing <- myWire -< ()
	integrate 0 -< thing * dt_

differentiateThings :: Wire Identity () Integer
differentiateThings = proc () -> do
	dt_ <- dt -< ()
	thing <- myWire -< ()
	differentiate -< thing * dt_

stepFourTimes :: Wire Identity () a -> a
stepFourTimes w0 =
	let
		(Identity (_y0,  w1)) = stepWire w0 ()
		(Identity (_y1,  w2)) = stepWire w1 ()
		(Identity (_y2,  w3)) = stepWire w2 ()
		(Identity ( y3, _w4)) = stepWire w3 ()

		result = y3
	in
		result

stepThrice :: Wire Identity () a -> a
stepThrice w0 =
	let
		(Identity (_y0,  w1)) = stepWire w0 ()
		(Identity (_y1,  w2)) = stepWire w1 ()
		(Identity ( y2, _w3)) = stepWire w2 ()

		result = y2
	in
		result

stepTwice :: Wire Identity () a -> a
stepTwice w0 =
	let
		(Identity (_y0,  w1)) = stepWire w0 ()
		(Identity ( y1, _w2)) = stepWire w1 ()

		result = y1
	in
		result

stepOnce :: Wire Identity () a -> a
stepOnce w0 =
	let
		(Identity (y0, _w1)) = stepWire w0 ()

		result = y0
	in
		result

waitThenEmit :: Wire Identity () (Maybe Integer)
waitThenEmit = proc () -> do
	rec out <- delay Nothing -< Just 3
	returnA -< out

holdingWire :: Wire Identity () Integer
holdingWire = proc () -> do
	couldBe <- waitThenEmit -< ()
	lastIs <- hold 1 -< couldBe
	returnA -< lastIs

queueingWire :: Wire Identity () (Maybe Integer)
queueingWire = proc () -> do
	pump <- delay [2,3,1] -< returnA []
	queue -< pump

tests :: TestTree
tests = testGroup "Immutaball.Share.Wire" $
	[
		testGroup "integrate / device tests" $
			[
				testCase "integrate twice" $
					stepThrice accumulateThings @?= 600,
				testCase "differentiate twice" $
					stepThrice differentiateThings @?= 0,
				testCase "differentiate once" $
					stepTwice differentiateThings @?= 0,
				testCase "differentiate never" $
					stepOnce differentiateThings @?= 0
			],

		testGroup "other utils tests" $
			let i = id :: Integer -> Integer in
			[
				testCase "hold thrice" $
					stepThrice holdingWire @?= 3,
				testCase "hold twice" $
					stepTwice holdingWire @?= 3,
				testCase "hold once" $
					stepOnce holdingWire @?= 1,

				testCase "queue four times" $
					stepFourTimes queueingWire @?= Nothing,
				testCase "queue thrice" $
					stepThrice queueingWire @?= Just 1,
				testCase "queue twice" $
					stepTwice queueingWire @?= Just 3,
				testCase "queue once" $
					stepOnce queueingWire @?= Just 2,

				testCase "delayNI 2 once" $
					stepOnce      (delayNI 2 7 <<< constWire 3) @?= i 7,
				testCase "delayNI 2 twice" $
					stepTwice     (delayNI 2 7 <<< constWire 3) @?= i 7,
				testCase "delayNI 2 thrice" $
					stepThrice    (delayNI 2 7 <<< constWire 3) @?= i 3,
				testCase "delayNI 2 four times" $
					stepFourTimes (delayNI 2 7 <<< constWire 3) @?= i 3
			]
	]