{-
	Copyright (C) 2018 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@]	The ordered sequence of /turn/s alternately made by the players of each /logical colour/.
-}

module BishBosh.State.TurnsByLogicalColour(
-- * Types
-- ** Type-synonyms
--	Transformation
-- ** Data-types
	TurnsByLogicalColour(
--		MkTurnsByLogicalColour,
--		getTurnsByLogicalColour,
		getNPlies
	),
-- * Functions
	inferNextLogicalColour,
	countPlies,
	deriveMoveNumber,
	dereference,
-- ** Constructors
	fromAssocs,
-- ** Mutators
	update,
	prepend
) where

import			Control.Arrow((&&&), (***))
import			Data.Array.IArray((!), (//))
import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Property.Empty		as Property.Empty
import qualified	BishBosh.Property.Null		as Property.Null
import qualified	BishBosh.Property.Opposable	as Property.Opposable
import qualified	BishBosh.Property.Reflectable	as Property.Reflectable
import qualified	BishBosh.Type.Count		as Type.Count
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.List.Extra

-- | The type used to hold a record of each player's /turn/s.
data TurnsByLogicalColour turn	= MkTurnsByLogicalColour {
	TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour	:: Colour.LogicalColour.ArrayByLogicalColour [turn],
	TurnsByLogicalColour turn -> NPlies
getNPlies		:: Type.Count.NPlies	-- ^ The total number of plies applied to the game for both players; this could alternatively be derived using 'countPlies'.
}

instance Eq turn => Eq (TurnsByLogicalColour turn) where
	MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
aL } == :: TurnsByLogicalColour turn -> TurnsByLogicalColour turn -> Bool
== MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
aR }	= ArrayByLogicalColour [turn]
aL ArrayByLogicalColour [turn] -> ArrayByLogicalColour [turn] -> Bool
forall a. Eq a => a -> a -> Bool
== ArrayByLogicalColour [turn]
aR

instance (Read turn, Show turn) => Read (TurnsByLogicalColour turn) where
	readsPrec :: NPlies -> ReadS (TurnsByLogicalColour turn)
readsPrec NPlies
precedence String
s	= ([(LogicalColour, [turn])] -> TurnsByLogicalColour turn)
-> ([(LogicalColour, [turn])], String)
-> (TurnsByLogicalColour turn, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
forall turn.
Show turn =>
[(LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs (([(LogicalColour, [turn])], String)
 -> (TurnsByLogicalColour turn, String))
-> [([(LogicalColour, [turn])], String)]
-> [(TurnsByLogicalColour turn, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` NPlies -> ReadS [(LogicalColour, [turn])]
forall a. Read a => NPlies -> ReadS a
readsPrec NPlies
precedence String
s

instance Show turn => Show (TurnsByLogicalColour turn) where
	showsPrec :: NPlies -> TurnsByLogicalColour turn -> ShowS
showsPrec NPlies
precedence MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour }	= NPlies -> [(LogicalColour, [turn])] -> ShowS
forall a. Show a => NPlies -> a -> ShowS
showsPrec NPlies
precedence ([(LogicalColour, [turn])] -> ShowS)
-> [(LogicalColour, [turn])] -> ShowS
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour [turn] -> [(LogicalColour, [turn])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour [turn]
byLogicalColour

instance Control.DeepSeq.NFData turn => Control.DeepSeq.NFData (TurnsByLogicalColour turn) where
	rnf :: TurnsByLogicalColour turn -> ()
rnf MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour }	= ArrayByLogicalColour [turn] -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayByLogicalColour [turn]
byLogicalColour

instance Data.Default.Default (TurnsByLogicalColour turn) where
	def :: TurnsByLogicalColour turn
def = MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
		getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour	= [[turn]] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([[turn]] -> ArrayByLogicalColour [turn])
-> [[turn]] -> ArrayByLogicalColour [turn]
forall a b. (a -> b) -> a -> b
$ [turn] -> [[turn]]
forall a. a -> [a]
repeat [],
		getNPlies :: NPlies
getNPlies		= NPlies
0
	}

instance Property.Empty.Empty (TurnsByLogicalColour turn) where
	empty :: TurnsByLogicalColour turn
empty	= TurnsByLogicalColour turn
forall a. Default a => a
Data.Default.def

instance Property.Null.Null (TurnsByLogicalColour turn) where
	isNull :: TurnsByLogicalColour turn -> Bool
isNull MkTurnsByLogicalColour { getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies = NPlies
0 }	= Bool
True
	isNull TurnsByLogicalColour turn
_					= Bool
False

instance Property.Reflectable.ReflectableOnX turn => Property.Reflectable.ReflectableOnX (TurnsByLogicalColour turn) where
	reflectOnX :: TurnsByLogicalColour turn -> TurnsByLogicalColour turn
reflectOnX turnsByLogicalColour :: TurnsByLogicalColour turn
turnsByLogicalColour@MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour }	= TurnsByLogicalColour turn
turnsByLogicalColour {
		getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour	= [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e.
IArray a e =>
[(LogicalColour, e)] -> a LogicalColour e
Colour.LogicalColour.arrayByLogicalColour ([(LogicalColour, [turn])] -> ArrayByLogicalColour [turn])
-> ([(LogicalColour, [turn])] -> [(LogicalColour, [turn])])
-> [(LogicalColour, [turn])]
-> ArrayByLogicalColour [turn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, [turn]) -> (LogicalColour, [turn]))
-> [(LogicalColour, [turn])] -> [(LogicalColour, [turn])]
forall a b. (a -> b) -> [a] -> [b]
map (
			LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite {-logical colour-} (LogicalColour -> LogicalColour)
-> ([turn] -> [turn])
-> (LogicalColour, [turn])
-> (LogicalColour, [turn])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [turn] -> [turn]
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX {-[turn]-}
		) ([(LogicalColour, [turn])] -> ArrayByLogicalColour [turn])
-> [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour [turn] -> [(LogicalColour, [turn])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour [turn]
byLogicalColour
	 }

-- | Smart constructor.
fromAssocs :: Show turn => [(Colour.LogicalColour.LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs :: [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
fromAssocs [(LogicalColour, [turn])]
assocs
	| NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
		[(LogicalColour, [turn])] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length [(LogicalColour, [turn])]
assocs
	) NPlies -> NPlies -> Bool
forall a. Eq a => a -> a -> Bool
/= NPlies
Colour.LogicalColour.nDistinctLogicalColours		= Exception -> TurnsByLogicalColour turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> TurnsByLogicalColour turn)
-> (String -> Exception) -> String -> TurnsByLogicalColour turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInsufficientData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.TurnsByLogicalColour.fromAssocs:\tboth logical colours must be defined; " (String -> TurnsByLogicalColour turn)
-> String -> TurnsByLogicalColour turn
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, [turn])] -> ShowS
forall a. Show a => a -> ShowS
shows [(LogicalColour, [turn])]
assocs String
"."
	| [LogicalColour] -> Bool
forall a. Eq a => [a] -> Bool
Data.List.Extra.anySame ([LogicalColour] -> Bool) -> [LogicalColour] -> Bool
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [turn]) -> LogicalColour)
-> [(LogicalColour, [turn])] -> [LogicalColour]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour, [turn]) -> LogicalColour
forall a b. (a, b) -> a
fst {-logicalColour-} [(LogicalColour, [turn])]
assocs	= Exception -> TurnsByLogicalColour turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> TurnsByLogicalColour turn)
-> (String -> Exception) -> String -> TurnsByLogicalColour turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.TurnsByLogicalColour.fromAssocs:\tduplicates specified; " (String -> TurnsByLogicalColour turn)
-> String -> TurnsByLogicalColour turn
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, [turn])] -> ShowS
forall a. Show a => a -> ShowS
shows [(LogicalColour, [turn])]
assocs String
"."
	| (NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
> NPlies
1) (NPlies -> Bool)
-> ((NPlies, NPlies) -> NPlies) -> (NPlies, NPlies) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPlies -> NPlies
forall a. Num a => a -> a
abs {-allow for Property.Reflectable.reflectOnX-} (NPlies -> NPlies)
-> ((NPlies, NPlies) -> NPlies) -> (NPlies, NPlies) -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPlies -> NPlies -> NPlies) -> (NPlies, NPlies) -> NPlies
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((NPlies, NPlies) -> Bool) -> (NPlies, NPlies) -> Bool
forall a b. (a -> b) -> a -> b
$ (
		[turn] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length ([turn] -> NPlies)
-> (Array LogicalColour [turn] -> [turn])
-> Array LogicalColour [turn]
-> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array LogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
Colour.LogicalColour.White) (Array LogicalColour [turn] -> NPlies)
-> (Array LogicalColour [turn] -> NPlies)
-> Array LogicalColour [turn]
-> (NPlies, NPlies)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [turn] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length ([turn] -> NPlies)
-> (Array LogicalColour [turn] -> [turn])
-> Array LogicalColour [turn]
-> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array LogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
Colour.LogicalColour.Black)
	) Array LogicalColour [turn]
byLogicalColour						= Exception -> TurnsByLogicalColour turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> TurnsByLogicalColour turn)
-> (String -> Exception) -> String -> TurnsByLogicalColour turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.TurnsByLogicalColour.fromAssocs:\tany difference in the number of turns taken by each player, can't exceed one " (String -> TurnsByLogicalColour turn)
-> String -> TurnsByLogicalColour turn
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, [turn])] -> ShowS
forall a. Show a => a -> ShowS
shows [(LogicalColour, [turn])]
assocs String
"."
	| Bool
otherwise							= TurnsByLogicalColour turn
turnsByLogicalColour
	where
		byLogicalColour :: Array LogicalColour [turn]
byLogicalColour		= [(LogicalColour, [turn])] -> Array LogicalColour [turn]
forall (a :: * -> * -> *) e.
IArray a e =>
[(LogicalColour, e)] -> a LogicalColour e
Colour.LogicalColour.arrayByLogicalColour [(LogicalColour, [turn])]
assocs
		turnsByLogicalColour :: TurnsByLogicalColour turn
turnsByLogicalColour	= MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
			getTurnsByLogicalColour :: Array LogicalColour [turn]
getTurnsByLogicalColour	= Array LogicalColour [turn]
byLogicalColour,
			getNPlies :: NPlies
getNPlies		= TurnsByLogicalColour turn -> NPlies
forall turn. TurnsByLogicalColour turn -> NPlies
countPlies TurnsByLogicalColour turn
turnsByLogicalColour	-- Infer.
		}

{- |
	* Derive the /logical colour/ of the next player to move.

	* CAVEAT: the result can't be guaranteed if 'Property.Reflectable.reflectOnX' has been called.
-}
inferNextLogicalColour :: TurnsByLogicalColour turn -> Colour.LogicalColour.LogicalColour
inferNextLogicalColour :: TurnsByLogicalColour turn -> LogicalColour
inferNextLogicalColour MkTurnsByLogicalColour { getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies = NPlies
nPlies }
	| NPlies -> Bool
forall a. Integral a => a -> Bool
even NPlies
nPlies	= LogicalColour
Colour.LogicalColour.White
	| Bool
otherwise	= LogicalColour
Colour.LogicalColour.Black

{- |
	* Count the total number of plies, regardless of the player.

	* CAVEAT: 'getNPlies' is more efficient.
-}
countPlies :: TurnsByLogicalColour turn -> Type.Count.NPlies
countPlies :: TurnsByLogicalColour turn -> NPlies
countPlies MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour }	= NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPlies -> NPlies) -> NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$ (NPlies -> [turn] -> NPlies)
-> NPlies -> ArrayByLogicalColour [turn] -> NPlies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (\NPlies
acc -> (NPlies -> NPlies -> NPlies
forall a. Num a => a -> a -> a
+ NPlies
acc) (NPlies -> NPlies) -> ([turn] -> NPlies) -> [turn] -> NPlies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [turn] -> NPlies
forall (t :: * -> *) a. Foldable t => t a -> NPlies
length) NPlies
0 ArrayByLogicalColour [turn]
byLogicalColour

-- | Derive the move-number, as used in PGN.
deriveMoveNumber :: TurnsByLogicalColour turn -> Type.Count.NMoves
deriveMoveNumber :: TurnsByLogicalColour turn -> NPlies
deriveMoveNumber MkTurnsByLogicalColour { getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies = NPlies
nPlies }	= NPlies -> NPlies
forall a. Enum a => a -> a
succ {-index from 1-} (NPlies -> NPlies) -> NPlies -> NPlies
forall a b. (a -> b) -> a -> b
$! NPlies -> NPlies
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPlies
nPlies NPlies -> NPlies -> NPlies
forall a. Integral a => a -> a -> a
`div` NPlies
2

-- | Dereference.
dereference :: TurnsByLogicalColour turn -> Colour.LogicalColour.LogicalColour -> [turn]
dereference :: TurnsByLogicalColour turn -> LogicalColour -> [turn]
dereference MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour } LogicalColour
logicalColour	= ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour

-- | Self-documentation.
type Transformation turn	= TurnsByLogicalColour turn -> TurnsByLogicalColour turn

{- |
	* Update the specified logical colours.

	* CAVEAT: obliterates any incumbent data for the specified logical colours.
-}
update :: [(Colour.LogicalColour.LogicalColour, [turn])] -> Transformation turn
update :: [(LogicalColour, [turn])] -> Transformation turn
update [(LogicalColour, [turn])]
assocs MkTurnsByLogicalColour { getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour = ArrayByLogicalColour [turn]
byLogicalColour }	= TurnsByLogicalColour turn
turnsByLogicalColour where
	turnsByLogicalColour :: TurnsByLogicalColour turn
turnsByLogicalColour	= MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
		getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour	= ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn]
-> [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(LogicalColour, [turn])]
assocs,
		getNPlies :: NPlies
getNPlies		= TurnsByLogicalColour turn -> NPlies
forall turn. TurnsByLogicalColour turn -> NPlies
countPlies TurnsByLogicalColour turn
turnsByLogicalColour	-- Infer.
	}

-- | Prepend the specified /turn/.
prepend :: Colour.LogicalColour.LogicalColour -> turn -> Transformation turn
prepend :: LogicalColour -> turn -> Transformation turn
prepend LogicalColour
logicalColour turn
turn MkTurnsByLogicalColour {
	getTurnsByLogicalColour :: forall turn.
TurnsByLogicalColour turn -> ArrayByLogicalColour [turn]
getTurnsByLogicalColour	= ArrayByLogicalColour [turn]
byLogicalColour,
	getNPlies :: forall turn. TurnsByLogicalColour turn -> NPlies
getNPlies		= NPlies
nPlies
} = MkTurnsByLogicalColour :: forall turn.
ArrayByLogicalColour [turn] -> NPlies -> TurnsByLogicalColour turn
MkTurnsByLogicalColour {
	getTurnsByLogicalColour :: ArrayByLogicalColour [turn]
getTurnsByLogicalColour	= ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn]
-> [(LogicalColour, [turn])] -> ArrayByLogicalColour [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
		(
			LogicalColour
logicalColour,
			turn
turn turn -> [turn] -> [turn]
forall a. a -> [a] -> [a]
: ArrayByLogicalColour [turn]
byLogicalColour ArrayByLogicalColour [turn] -> LogicalColour -> [turn]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
		) -- Pair.
	], -- Singleton.
	getNPlies :: NPlies
getNPlies	= NPlies -> NPlies
forall a. Enum a => a -> a
succ NPlies
nPlies
}