packages feed

bishbosh-0.1.1.0: src-test/BishBosh/Test/HUnit/Time/GameClock.hs

{-
	Copyright (C) 2021 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Static tests.
-}

module BishBosh.Test.HUnit.Time.GameClock(
-- * Constants
	testCases
) where

import qualified	BishBosh.Time.GameClock			as Time.GameClock
import qualified	BishBosh.Time.StopWatch			as Time.StopWatch
import qualified	BishBosh.Property.SelfValidating	as Property.SelfValidating
import qualified	BishBosh.Property.Switchable		as Property.Switchable
import qualified	Control.Concurrent
import qualified	Data.Array.IArray
import qualified	Data.Foldable
import qualified	System.Random
import qualified	Test.HUnit
import			Test.HUnit((@?))

-- | Check the sanity of the implementation, by validating a list of static test-cases.
testCases :: Test.HUnit.Test
testCases	= Test.HUnit.test $ map Test.HUnit.TestCase [
	do
		stoppedGameClock	<- Property.Switchable.switchOff =<< Property.Switchable.on

		Property.Switchable.isOff (stoppedGameClock :: Time.GameClock.GameClock) @? "Property.Switchable.switchOff failed.",
	do
		runningGameClock	<- flick 2

		Property.Switchable.isOn runningGameClock @? "Property.Switchable.Property.Switchable.flick (double) failed.",
	do
		runningGameClock	<- flick 3

		Property.Switchable.isOn runningGameClock @? "Property.Switchable.Property.Switchable.flick (triple) failed.",
	do
		runningGameClock	<- flick 3

		Property.SelfValidating.isValid runningGameClock @? "Property.Switchable.Property.SelfValidating.isValid failed.",
	let
		delayedFlick :: [Int] -> Time.GameClock.GameClock -> IO Time.GameClock.GameClock
		delayedFlick (t : ts) gameClock	= do
			Control.Concurrent.threadDelay t

			Property.Switchable.toggle gameClock >>= delayedFlick ts
		delayedFlick _ gameClock	= return {-to IO-monad-} gameClock
	 in do
		randomGenerator		<- System.Random.getStdGen
		runningWatch		<- Property.Switchable.on
		stoppedGameClock	<- Property.Switchable.switchOff =<< delayedFlick (take 16 $ System.Random.randomRs (1, 100000 {-uS-}) randomGenerator) =<< Property.Switchable.on
		stoppedWatch		<- Property.Switchable.switchOff runningWatch

		let
			relativeError :: Rational
			relativeError	= pred . (/ Time.StopWatch.getElapsedTime stoppedWatch) . Data.Foldable.sum . Data.Array.IArray.amap Time.StopWatch.getElapsedTime $ Time.GameClock.deconstruct stoppedGameClock

		abs relativeError < recip 50000 @? showString "Time.GameClock.GameClock:\trelative error between sum of game-clock times & stop-watch time = " (
			 shows (realToFrac relativeError :: Double) "."
		 )
 ] where
	flick :: Int -> IO Time.GameClock.GameClock
	flick n	= Property.Switchable.on >>= Property.Switchable.flick n