{-
	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@]	Defines two stop-watches, exactly one of which is running at any time.
-}

module BishBosh.Time.GameClock(
-- * Types
-- ** Data-types
	GameClock(
--		MkGameClock,
		deconstruct
	),
-- * Functions
	showsElapsedTimes
 ) where

import			Control.Arrow((***))
import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour
import qualified	BishBosh.Data.Exception			as Data.Exception
import qualified	BishBosh.Property.SelfValidating	as Property.SelfValidating
import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat
import qualified	BishBosh.Property.Switchable		as Property.Switchable
import qualified	BishBosh.Text.ShowList			as Text.ShowList
import qualified	BishBosh.Time.StopWatch			as Time.StopWatch
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Default
import qualified	Data.Foldable

-- | Models a game-clock, in which each player owns a personal stop-watch, exactly one of which is running at any one time.
newtype GameClock	= MkGameClock {
	GameClock -> ArrayByLogicalColour StopWatch
deconstruct	:: Colour.LogicalColour.ArrayByLogicalColour Time.StopWatch.StopWatch -- ^ Contains one stop-watch for each of two players.
}

instance Property.Switchable.Switchable GameClock where
	on :: IO GameClock
on	= (StopWatch -> GameClock) -> IO StopWatch -> IO GameClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
		ArrayByLogicalColour StopWatch -> GameClock
MkGameClock (ArrayByLogicalColour StopWatch -> GameClock)
-> (StopWatch -> ArrayByLogicalColour StopWatch)
-> StopWatch
-> GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> ArrayByLogicalColour StopWatch
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([StopWatch] -> ArrayByLogicalColour StopWatch)
-> (StopWatch -> [StopWatch])
-> StopWatch
-> ArrayByLogicalColour StopWatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			StopWatch
forall a. Default a => a
Data.Default.def StopWatch -> [StopWatch] -> [StopWatch]
forall a. a -> [a] -> [a]
:	-- A stopped watch for Black.
		) ([StopWatch] -> [StopWatch])
-> (StopWatch -> [StopWatch]) -> StopWatch -> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StopWatch -> [StopWatch]
forall (m :: * -> *) a. Monad m => a -> m a
return {-to List-monad-}
	 ) IO StopWatch
forall a. Switchable a => IO a
Property.Switchable.on		-- A running watch for White.

	toggle :: GameClock -> IO GameClock
toggle GameClock
gameClock
		| errorMessages :: [String]
errorMessages@(String
_ : [String]
_)	<- GameClock -> [String]
forall a. SelfValidating a => a -> [String]
Property.SelfValidating.findInvalidity GameClock
gameClock	= Exception -> IO GameClock
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (Exception -> IO GameClock)
-> (String -> Exception) -> String -> IO GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> (String -> String) -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"Duel.Process.Intermediary.initialise:\tinvalid gameClock; " (String -> IO GameClock) -> String -> IO GameClock
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Show a => a -> String
show [String]
errorMessages
		| Bool
otherwise									= ([StopWatch] -> GameClock) -> IO [StopWatch] -> IO GameClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
			ArrayByLogicalColour StopWatch -> GameClock
MkGameClock (ArrayByLogicalColour StopWatch -> GameClock)
-> ([StopWatch] -> ArrayByLogicalColour StopWatch)
-> [StopWatch]
-> GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> ArrayByLogicalColour StopWatch
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour
		) (IO [StopWatch] -> IO GameClock)
-> (ArrayByLogicalColour StopWatch -> IO [StopWatch])
-> ArrayByLogicalColour StopWatch
-> IO GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StopWatch -> IO StopWatch) -> [StopWatch] -> IO [StopWatch]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM StopWatch -> IO StopWatch
forall a. Switchable a => a -> IO a
Property.Switchable.toggle ([StopWatch] -> IO [StopWatch])
-> (ArrayByLogicalColour StopWatch -> [StopWatch])
-> ArrayByLogicalColour StopWatch
-> IO [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [StopWatch]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (ArrayByLogicalColour StopWatch -> IO GameClock)
-> ArrayByLogicalColour StopWatch -> IO GameClock
forall a b. (a -> b) -> a -> b
$ GameClock -> ArrayByLogicalColour StopWatch
deconstruct GameClock
gameClock

	switchOff :: GameClock -> IO GameClock
switchOff	= ([StopWatch] -> GameClock) -> IO [StopWatch] -> IO GameClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
		ArrayByLogicalColour StopWatch -> GameClock
MkGameClock (ArrayByLogicalColour StopWatch -> GameClock)
-> ([StopWatch] -> ArrayByLogicalColour StopWatch)
-> [StopWatch]
-> GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> ArrayByLogicalColour StopWatch
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour
	 ) (IO [StopWatch] -> IO GameClock)
-> (GameClock -> IO [StopWatch]) -> GameClock -> IO GameClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StopWatch -> IO StopWatch) -> [StopWatch] -> IO [StopWatch]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM StopWatch -> IO StopWatch
forall a. Switchable a => a -> IO a
Property.Switchable.switchOff ([StopWatch] -> IO [StopWatch])
-> (GameClock -> [StopWatch]) -> GameClock -> IO [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [StopWatch]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (ArrayByLogicalColour StopWatch -> [StopWatch])
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct	-- CAVEAT: this invalidates the clock, since a subsequent call to 'toggle' would activate both stop-watches.

	isOn :: GameClock -> Bool
isOn	= (StopWatch -> Bool) -> ArrayByLogicalColour StopWatch -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.any StopWatch -> Bool
forall a. Switchable a => a -> Bool
Property.Switchable.isOn (ArrayByLogicalColour StopWatch -> Bool)
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct	-- CAVEAT: includes the dysfunctional state in which both sides are running.

	isOff :: GameClock -> Bool
isOff	= (StopWatch -> Bool) -> ArrayByLogicalColour StopWatch -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all StopWatch -> Bool
forall a. Switchable a => a -> Bool
Property.Switchable.isOff (ArrayByLogicalColour StopWatch -> Bool)
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct

instance Property.SelfValidating.SelfValidating GameClock where
	findInvalidity :: GameClock -> [String]
findInvalidity	= [(GameClock -> Bool, String)] -> GameClock -> [String]
forall selfValidator.
[(selfValidator -> Bool, String)] -> selfValidator -> [String]
Property.SelfValidating.findErrors [
		((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (Int -> Bool) -> (GameClock -> Int) -> GameClock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StopWatch] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([StopWatch] -> Int)
-> (GameClock -> [StopWatch]) -> GameClock -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StopWatch -> Bool) -> [StopWatch] -> [StopWatch]
forall a. (a -> Bool) -> [a] -> [a]
filter StopWatch -> Bool
forall a. Switchable a => a -> Bool
Property.Switchable.isOn ([StopWatch] -> [StopWatch])
-> (GameClock -> [StopWatch]) -> GameClock -> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [StopWatch]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (ArrayByLogicalColour StopWatch -> [StopWatch])
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> [StopWatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct,	String
"The two stop-watches must be in opposite states")
	 ]

-- | Show the elapsed times.
showsElapsedTimes :: Type.Count.NDecimalDigits -> GameClock -> IO ShowS
showsElapsedTimes :: Int -> GameClock -> IO (String -> String)
showsElapsedTimes Int
nDecimalDigits	= (GameClock -> String -> String)
-> IO GameClock -> IO (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (
	[(String, String -> String)] -> String -> String
Text.ShowList.showsAssociationList' ([(String, String -> String)] -> String -> String)
-> (GameClock -> [(String, String -> String)])
-> GameClock
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, StopWatch) -> (String, String -> String))
-> [(LogicalColour, StopWatch)] -> [(String, String -> String)]
forall a b. (a -> b) -> [a] -> [b]
map (
		LogicalColour -> String
forall a. Show a => a -> String
show (LogicalColour -> String)
-> (StopWatch -> String -> String)
-> (LogicalColour, StopWatch)
-> (String, String -> String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> StopWatch -> String -> String
forall a. ShowFloat a => Int -> a -> String -> String
Property.ShowFloat.showsFloatToN Int
nDecimalDigits
	) ([(LogicalColour, StopWatch)] -> [(String, String -> String)])
-> (GameClock -> [(LogicalColour, StopWatch)])
-> GameClock
-> [(String, String -> String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByLogicalColour StopWatch -> [(LogicalColour, StopWatch)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (ArrayByLogicalColour StopWatch -> [(LogicalColour, StopWatch)])
-> (GameClock -> ArrayByLogicalColour StopWatch)
-> GameClock
-> [(LogicalColour, StopWatch)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> ArrayByLogicalColour StopWatch
deconstruct
 ) (IO GameClock -> IO (String -> String))
-> (GameClock -> IO GameClock)
-> GameClock
-> IO (String -> String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameClock -> IO GameClock
forall a. Switchable a => a -> IO a
Property.Switchable.switchOff