packages feed

bishbosh-0.1.3.0: src-lib/BishBosh/Model/Game.hs

{-
	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@]

	* This module augments "State.Board" with the history of the game.

	* It therefore understands not only the current state of the /board/, but also; whose turn it is, whether /Castling/ has occured, which @Pawn@s have been /promoted/, when /piece/s were taken.

	* Moves made in this domain conform to the rules of chess, c.f. those made in "State.Board".
-}

module BishBosh.Model.Game(
-- * Types
-- ** Type-synonyms
--	InstancesByPosition,
--	AvailableQualifiedMoves,
--	AvailableQualifiedMovesByLogicalColour,
	Transformation,
-- ** Data-types
	Game(
--		MkGame,
		getNextLogicalColour,
		getCastleableRooksByLogicalColour,
		getBoard,
		getTurnsByLogicalColour,
		getMaybeChecked,
		getInstancesByPosition,
		getAvailableQualifiedMovesByLogicalColour,
		getMaybeTerminationReason
	),
-- * Functions
--	inferMaybeTerminationReason,
	countPliesAvailableTo,
	rollBack,
--	listMaybePromotionRanks,
--	listQualifiedMovesAvailableTo,
	sortAvailableQualifiedMoves,
	findQualifiedMovesAvailableTo,
	findQualifiedMovesAvailableToNextPlayer,
	listTurns,
	listTurnsChronologically,
	maybeLastTurn,
--	findAvailableCastlingMoves,
	validateQualifiedMove,
	validateEitherQualifiedMove,
	updateIncrementalPositionHash,
-- ** Constructors
	mkPosition,
--	mkInstancesByPosition,
	mkGame,
	fromBoard,
	mkAvailableQualifiedMovesFor,
-- ** Mutators
	takeTurn,
	applyQualifiedMove,
	applyEitherQualifiedMove,
	applyEitherQualifiedMoves,
	updateTerminationReasonWith,
--	resignationBy,
	resign,
--	agreeToADraw,
-- ** Predicates
	isValidQualifiedMove,
	isValidEitherQualifiedMove,
	isTerminated,
	cantConverge,
	(=~),
	(/~)
) where

import			Control.Arrow((&&&), (***), (|||))
import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType
import qualified	BishBosh.Attribute.Rank				as Attribute.Rank
import qualified	BishBosh.Cartesian.Abscissa			as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Coordinates			as Cartesian.Coordinates
import qualified	BishBosh.Cartesian.Vector			as Cartesian.Vector
import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour
import qualified	BishBosh.Component.CastlingMove			as Component.CastlingMove
import qualified	BishBosh.Component.EitherQualifiedMove		as Component.EitherQualifiedMove
import qualified	BishBosh.Component.Move				as Component.Move
import qualified	BishBosh.Component.Piece			as Component.Piece
import qualified	BishBosh.Component.QualifiedMove		as Component.QualifiedMove
import qualified	BishBosh.Component.Turn				as Component.Turn
import qualified	BishBosh.Component.Zobrist			as Component.Zobrist
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Notation.MoveNotation			as Notation.MoveNotation
import qualified	BishBosh.Notation.Notation			as Notation.Notation
import qualified	BishBosh.Notation.PureCoordinate		as Notation.PureCoordinate
import qualified	BishBosh.Property.Empty				as Property.Empty
import qualified	BishBosh.Property.ExtendedPositionDescription	as Property.ExtendedPositionDescription
import qualified	BishBosh.Property.FixedMembership		as Property.FixedMembership
import qualified	BishBosh.Property.ForsythEdwards		as Property.ForsythEdwards
import qualified	BishBosh.Property.Null				as Property.Null
import qualified	BishBosh.Property.Opposable			as Property.Opposable
import qualified	BishBosh.Property.Orientated			as Property.Orientated
import qualified	BishBosh.Property.Reflectable			as Property.Reflectable
import qualified	BishBosh.Rule.DrawReason			as Rule.DrawReason
import qualified	BishBosh.Rule.GameTerminationReason		as Rule.GameTerminationReason
import qualified	BishBosh.Rule.Result				as Rule.Result
import qualified	BishBosh.State.Board				as State.Board
import qualified	BishBosh.State.CastleableRooksByLogicalColour	as State.CastleableRooksByLogicalColour
import qualified	BishBosh.State.CoordinatesByRankByLogicalColour	as State.CoordinatesByRankByLogicalColour
import qualified	BishBosh.State.EnPassantAbscissa		as State.EnPassantAbscissa
import qualified	BishBosh.State.InstancesByPosition		as State.InstancesByPosition
import qualified	BishBosh.State.MaybePieceByCoordinates		as State.MaybePieceByCoordinates
import qualified	BishBosh.State.Position				as State.Position
import qualified	BishBosh.StateProperty.Censor			as StateProperty.Censor
import qualified	BishBosh.StateProperty.Hashable			as StateProperty.Hashable
import qualified	BishBosh.StateProperty.Mutator			as StateProperty.Mutator
import qualified	BishBosh.StateProperty.Seeker			as StateProperty.Seeker
import qualified	BishBosh.State.TurnsByLogicalColour		as State.TurnsByLogicalColour
import qualified	BishBosh.Text.ShowList				as Text.ShowList
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	BishBosh.Type.Crypto				as Type.Crypto
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Bits
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	Data.Map					as Map
import qualified	Data.Maybe
import qualified	Data.Ord
import qualified	ToolShed.Data.List

infix 4 =~, /~	-- Same as (==) & (/=).

{- |
	* Focus the polymorphic key-type used by 'State.InstancesByPosition.InstancesByPosition'.

	* N.B. ideally a hash of the position would be used as the key,
	but to achieve that the same random numbers from which it is constructed, would have to be passed to 'takeTurn' throughout the life-time of the 'Game'.
	Regrettably, class-instances can only use @ Data.Default.def :: Zobrist @, which must then be assumed by the users of all methods.
	Building 'Component.Zobrist.Zobrist' into 'Game' would break the instance of 'Eq'.
	Building a hash-constructor into 'Game' would break the instance of @ (Eq, Read, Show) @.
-}
type InstancesByPosition	= State.InstancesByPosition.InstancesByPosition State.Position.Position

-- | The /move/s available to one player, indexed by the source-/coordinates/ of the /move/.
type AvailableQualifiedMoves	= (
	Map.Map Cartesian.Coordinates.Coordinates	-- Source.
 ) [
	(
		Cartesian.Coordinates.Coordinates,	-- Destination.
		Attribute.MoveType.MoveType
	)
 ]

-- | Sort the lists of destinations to faciliate testing for equality.
sortAvailableQualifiedMoves :: AvailableQualifiedMoves -> AvailableQualifiedMoves
sortAvailableQualifiedMoves	= Map.map . Data.List.sortBy $ Data.Ord.comparing fst {-destination-}

-- | The /move/s available to both players.
type AvailableQualifiedMovesByLogicalColour	= Map.Map Colour.LogicalColour.LogicalColour AvailableQualifiedMoves

{- |
	* The first three fields represent the state of the /game/.

	* These are augmented by the /game/'s history, i.e. the sequence of /move/s.

	* For efficiency the list of available /move/s is stored.
-}
data Game	= MkGame {
	getNextLogicalColour				:: Colour.LogicalColour.LogicalColour,					-- ^ N.B.: can be derived from 'getTurnsByLogicalColour', unless 'Property.Reflectable.reflectOnX' has been called.
	getCastleableRooksByLogicalColour		:: State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour,	-- ^ Those @Rook@s which can still participate in castling.
	getBoard					:: State.Board.Board,							-- ^ The current state of the /board/.
	getTurnsByLogicalColour				:: State.CastleableRooksByLogicalColour.TurnsByLogicalColour,		-- ^ Successive /move/s & any /piece/ taken, recorded by player.
	getMaybeChecked					:: Maybe Colour.LogicalColour.LogicalColour,				-- ^ The player (if any), whose currently /checked/; which will typically be 'getNextLogicalColour', but 'listQualifiedMovesAvailableTo' can be called for either player.
	getInstancesByPosition				:: InstancesByPosition,							-- ^ The number of instances of various positions since the last unrepeatable move.
	getAvailableQualifiedMovesByLogicalColour	:: AvailableQualifiedMovesByLogicalColour,				-- ^ The /move/s available to each player. Since this is merely required for efficiency, it needn't have an entry for both players; & typically doesn't when checked, since radical pruning would otherwise be required. CAVEAT: doesn't account for game-termination.
	getMaybeTerminationReason			:: Maybe Rule.GameTerminationReason.GameTerminationReason		-- ^ The reason (where appropriate) why the game was terminated.
}

instance Eq Game where
	MkGame {
		getNextLogicalColour				= nextLogicalColour,
		getCastleableRooksByLogicalColour		= castleableRooksByLogicalColour,
		getBoard					= board,
		getTurnsByLogicalColour				= turnsByLogicalColour,
		getMaybeChecked					= maybeChecked,
		getInstancesByPosition				= instancesByPosition,
		getAvailableQualifiedMovesByLogicalColour	= availableQualifiedMovesByLogicalColour,
		getMaybeTerminationReason			= maybeTerminationReason
	} == MkGame {
		getNextLogicalColour				= nextLogicalColour',
		getCastleableRooksByLogicalColour		= castleableRooksByLogicalColour',
		getBoard					= board',
		getTurnsByLogicalColour				= turnsByLogicalColour',
		getMaybeChecked					= maybeChecked',
		getInstancesByPosition				= instancesByPosition',
		getAvailableQualifiedMovesByLogicalColour	= availableQualifiedMovesByLogicalColour',
		getMaybeTerminationReason			= maybeTerminationReason'
	} = (
		nextLogicalColour,
		castleableRooksByLogicalColour,
		board,
		turnsByLogicalColour,
		maybeChecked,
		instancesByPosition,
		Map.map sortAvailableQualifiedMoves availableQualifiedMovesByLogicalColour,
		maybeTerminationReason
	 ) == (
		nextLogicalColour',
		castleableRooksByLogicalColour',
		board',
		turnsByLogicalColour',
		maybeChecked',
		instancesByPosition',
		Map.map sortAvailableQualifiedMoves availableQualifiedMovesByLogicalColour',
		maybeTerminationReason'
	 )

instance Control.DeepSeq.NFData Game where
	rnf MkGame {
		getNextLogicalColour				= nextLogicalColour,
		getCastleableRooksByLogicalColour		= castleableRooksByLogicalColour,
		getBoard					= board,
		getTurnsByLogicalColour				= turnsByLogicalColour,
		getMaybeChecked					= maybeChecked,
		getInstancesByPosition				= instancesByPosition,
		getAvailableQualifiedMovesByLogicalColour	= availableQualifiedMovesByLogicalColour,
		getMaybeTerminationReason			= maybeTerminationReason
	} = Control.DeepSeq.rnf (
		nextLogicalColour,
		castleableRooksByLogicalColour,
		board,
		turnsByLogicalColour,
		maybeChecked,
		instancesByPosition,
		availableQualifiedMovesByLogicalColour,
		maybeTerminationReason
	 ) -- Represent as a tuple.

instance Show Game where
	showsPrec precedence MkGame {
		getBoard			= board,
		getTurnsByLogicalColour		= turnsByLogicalColour,
		getMaybeTerminationReason	= maybeTerminationReason
	} = showsPrec precedence (
		board,
		turnsByLogicalColour,
		maybeTerminationReason
	 ) -- Represent as a tuple those fields which can't be inferred.

instance Read Game where
	readsPrec precedence	= map (
		Control.Arrow.first $ \(
			board,
			turnsByLogicalColour,
			maybeTerminationReason
		) {-tuple-} -> let
			game = (
				uncurry mkGame (
					State.TurnsByLogicalColour.inferNextLogicalColour &&& State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour $ turnsByLogicalColour
				) board turnsByLogicalColour
			 ) {
				getInstancesByPosition		= mkInstancesByPosition game,
				getMaybeTerminationReason	= maybeTerminationReason
			}
		in game
	 ) . readsPrec precedence

instance Data.Default.Default Game where
	def = (
		mkGame Colour.LogicalColour.White Data.Default.def {-castleableRooksByLogicalColour-} Data.Default.def {-board-} Data.Default.def {-turnsByLogicalColour-}
	 ) {
		getMaybeChecked					= Nothing,
		getAvailableQualifiedMovesByLogicalColour	= Map.fromAscList $ map (
			id &&& mkAvailableQualifiedMovesFor Data.Default.def {-game-}
		) Property.FixedMembership.members
	}

instance Property.ExtendedPositionDescription.ReadsEPD Game where
	readsEPD s	= [
		(
			mkGame nextLogicalColour castleableRooksByLogicalColour board turnsByLogicalColour,
			s4
		) |
			(board, s1)				<- Property.ExtendedPositionDescription.readsEPD s,
			(nextLogicalColour, s2)			<- Property.ExtendedPositionDescription.readsEPD s1,
			(castleableRooksByLogicalColour, s3)	<- Property.ExtendedPositionDescription.readsEPD s2,
			(turnsByLogicalColour, s4)		<- case Data.List.Extra.trimStart s3 of
				'-' : s4'	-> [(Property.Empty.empty {-TurnsByLogicalColour-}, s4')]
				s3'		-> Control.Arrow.first (
					\enPassantDestination -> let
						opponentsLogicalColour	= Property.Opposable.getOpposite nextLogicalColour
					in State.TurnsByLogicalColour.fromAssocs [
						(
							nextLogicalColour,
							[]
						), (
							opponentsLogicalColour,
							[
								Component.Turn.mkTurn (
									Component.QualifiedMove.mkQualifiedMove (
										uncurry Component.Move.mkMove $ (
											uncurry Cartesian.Coordinates.retreat &&& uncurry Cartesian.Coordinates.advance
										) (opponentsLogicalColour, enPassantDestination)	-- Reconstruct the recent Pawn double-advance.
									) Data.Default.def {-move-type-}
								) Attribute.Rank.Pawn
							] -- Singleton.
						) -- Pair.
					]
				 ) `map` Notation.Notation.readsCoordinates Notation.PureCoordinate.notation s3' -- En-passant destination.
	 ] -- List-comprehension.

instance Property.ExtendedPositionDescription.ShowsEPD Game where
	showsEPD game@MkGame {
		getNextLogicalColour			= nextLogicalColour,
		getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour,
		getBoard				= board
	 } = Text.ShowList.showsDelimitedList Property.ExtendedPositionDescription.showsSeparator id id [
		Property.ExtendedPositionDescription.showsEPD board,				-- 1. Placement of pieces.
		Property.ExtendedPositionDescription.showsEPD nextLogicalColour,		-- 2. Active colour.
		Property.ExtendedPositionDescription.showsEPD castleableRooksByLogicalColour,	-- 3. Castling availability.
		Data.Maybe.maybe Property.ExtendedPositionDescription.showsNullField (
			\turn -> if Component.Turn.isPawnDoubleAdvance turn $ Property.Opposable.getOpposite nextLogicalColour
				then Notation.MoveNotation.showsNotation Data.Default.def {-Smith is the same as the required Algebraic notation in this limited role-} . Cartesian.Coordinates.advance nextLogicalColour . Component.Move.getDestination . Component.QualifiedMove.getMove $ Component.Turn.getQualifiedMove turn
				else Property.ExtendedPositionDescription.showsNullField
		) $ maybeLastTurn game	-- 4. En-passant target square. CAVEAT: in contrast to X-EPD, this is required even when there's no opposing Pawn in a suitable position to take en-passant.
	 ]

-- CAVEAT: some information is lost during 'showsFEN', which can't subsequently be recovered by 'readsFEN'.
instance Property.ForsythEdwards.ReadsFEN Game where
	readsFEN s	= [
		(game, s3) |
			(game, s1)		<- Property.ExtendedPositionDescription.readsEPD s,
			(_halfMoveClock, s2)	<- reads s1 :: [(Int, String)],
			(_fullMoveCounter, s3)	<- reads s2 :: [(Int, String)]
	 ] -- List-comprehension.

instance Property.ForsythEdwards.ShowsFEN Game where
	showsFEN game@MkGame {
		getTurnsByLogicalColour	= turnsByLogicalColour,
		getInstancesByPosition	= instancesByPosition
	 } = Text.ShowList.showsDelimitedList Property.ExtendedPositionDescription.showsSeparator id id [
		Property.ExtendedPositionDescription.showsEPD game,
		shows $ State.InstancesByPosition.countConsecutiveRepeatablePlies instancesByPosition, -- 5. Half move clock.
		shows . succ {-the full-move counter starts at '1', before any move has occurred-} . length $ State.TurnsByLogicalColour.dereference turnsByLogicalColour Colour.LogicalColour.Black	-- 6. Full move counter.
	 ]

instance Property.Empty.Empty Game where
	empty	= Data.Default.def	-- i.e. zero turns have been taken, rather than zero pieces remain (which is illegal).

instance Property.Null.Null Game where
	isNull MkGame { getTurnsByLogicalColour = turnsByLogicalColour }	= Property.Null.isNull turnsByLogicalColour

{- |
	* Create an alternative game in which @Black@ moved first; <https://www.chessprogramming.org/Color_Flipping>.

	* N.B.: 'Property.Reflectable.ReflectableOnY' isn't implemented,
	since /reflectOnY/ produces a mirror-image /board/ in which the royal /piece/s start in a non-standard position & castling occurs the wrong way.
-}
instance Property.Reflectable.ReflectableOnX Game where
	reflectOnX MkGame {
		getNextLogicalColour			= nextLogicalColour,
		getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour,
		getBoard				= board,
		getTurnsByLogicalColour			= turnsByLogicalColour,
		getInstancesByPosition			= instancesByPosition,
		getMaybeTerminationReason		= maybeTerminationReason
	} = (
		mkGame (
			Property.Opposable.getOpposite nextLogicalColour
		) (
			Property.Reflectable.reflectOnX castleableRooksByLogicalColour
		) (
			Property.Reflectable.reflectOnX board
		) (
			Property.Reflectable.reflectOnX turnsByLogicalColour
		)
	 ) {
		getInstancesByPosition		= Property.Reflectable.reflectOnX instancesByPosition,
		getMaybeTerminationReason	= fmap Property.Opposable.getOpposite maybeTerminationReason
	}

instance StateProperty.Hashable.Hashable Game where
	listRandoms zobrist game@MkGame {
		getNextLogicalColour			= nextLogicalColour,
		getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour,
		getBoard				= board
	} = (
		if Colour.LogicalColour.isBlack nextLogicalColour
			then (Component.Zobrist.getRandomForBlacksMove zobrist :)
			else id
	 ) $ StateProperty.Hashable.listRandoms zobrist (
		maybeLastTurn game >>= State.EnPassantAbscissa.mkMaybeEnPassantAbscissa nextLogicalColour (
			State.Board.getMaybePieceByCoordinates board
		),
		castleableRooksByLogicalColour,
		board
	 ) -- Triple.

-- | Smart constructor.
mkGame
	:: Colour.LogicalColour.LogicalColour	-- ^ The player who is required to move next.
	-> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour
	-> State.Board.Board
	-> State.CastleableRooksByLogicalColour.TurnsByLogicalColour
	-> Game
mkGame nextLogicalColour castleableRooksByLogicalColour board turnsByLogicalColour
	| not . StateProperty.Censor.hasBothKings $ State.Board.getCoordinatesByRankByLogicalColour board	= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Model.Game.mkGame:\tboth Kings must exist; " $ shows board "."
	| State.Board.isKingChecked board $ Property.Opposable.getOpposite nextLogicalColour			= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Model.Game.mkGame:\tthe player who last moved, is still checked; " $ shows board "."
	| otherwise	= game
	where
		game = MkGame {
			getNextLogicalColour				= nextLogicalColour,
			getCastleableRooksByLogicalColour		= castleableRooksByLogicalColour,
			getBoard					= board,
			getTurnsByLogicalColour				= turnsByLogicalColour,
			getMaybeChecked					= Data.List.find (State.Board.isKingChecked board) Property.FixedMembership.members,
			getInstancesByPosition				= State.InstancesByPosition.mkSingleton $ mkPosition game,
			getAvailableQualifiedMovesByLogicalColour	= Map.fromAscList [
				(logicalColour, mkAvailableQualifiedMovesFor game logicalColour) |
					logicalColour	<- Property.FixedMembership.members,
					getMaybeChecked game /= Just logicalColour	-- Define the available qualified moves for unchecked players only.
			], -- List-comprehension.
			getMaybeTerminationReason			= inferMaybeTerminationReason game
		}

{- | Constructor.
	For convenience, the following assumptions are made in the absence of any move-history:

		* The next player's /logical colour/ is assumed to be @White@;

		* Provided that the @King@ is at its starting /coordinates/, then all @Rook@s which exist at their starting /coordinates/ are considered to be castleable;

		* There're zero previous turns.
-}
fromBoard :: State.Board.Board -> Game
fromBoard board	= mkGame Colour.LogicalColour.White (
	State.CastleableRooksByLogicalColour.fromBoard board
 ) board Property.Empty.empty {-TurnsByLogicalColour-}

-- | Gets the sequence of /turn/s, with the latest at the head & the opening one last.
listTurns :: Game -> [Component.Turn.Turn]
listTurns MkGame {
	getNextLogicalColour	= nextLogicalColour,
	getTurnsByLogicalColour	= turnsByLogicalColour
} = uncurry ToolShed.Data.List.interleave $ (
	State.TurnsByLogicalColour.dereference turnsByLogicalColour . Property.Opposable.getOpposite &&& State.TurnsByLogicalColour.dereference turnsByLogicalColour
 ) nextLogicalColour

-- | Gets the sequence of /turn/s in the order they occured.
listTurnsChronologically :: Game -> [Component.Turn.Turn]
listTurnsChronologically	= reverse . listTurns

-- | The last /turn/, if there was one.
maybeLastTurn :: Game -> Maybe Component.Turn.Turn
maybeLastTurn MkGame {
	getNextLogicalColour	= nextLogicalColour,
	getTurnsByLogicalColour	= turnsByLogicalColour
} = Data.Maybe.listToMaybe . State.TurnsByLogicalColour.dereference turnsByLogicalColour $ Property.Opposable.getOpposite nextLogicalColour

{- |
	* Returns the castling /move/s currently available to the @King@ of the specified /logical colour/.

	* N.B.: only the @King@'s component of the /move/ is returned.

	* CAVEAT: this is a performance-hotspot; refactor => re-profile.
-}
findAvailableCastlingMoves :: Game -> Colour.LogicalColour.LogicalColour -> [Component.QualifiedMove.QualifiedMove]
findAvailableCastlingMoves MkGame {
	getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour,
	getBoard				= board,
	getMaybeChecked				= maybeChecked
} logicalColour
	| Just checkedLogicalColour	<- maybeChecked
	, checkedLogicalColour == logicalColour	= []	-- One can't Castle out of check.
	| Just rooksStartingXs	<- State.CastleableRooksByLogicalColour.locateForLogicalColour castleableRooksByLogicalColour logicalColour	= [
		Component.QualifiedMove.mkQualifiedMove castlingKingsMove $ Component.CastlingMove.getMoveType castlingMove |
			x		<- rooksStartingXs,
			castlingMove	<- Component.CastlingMove.getCastlingMoves logicalColour,
			let castlingRooksSource	= Component.Move.getSource $ Component.CastlingMove.getRooksMove castlingMove,
			Cartesian.Coordinates.getX castlingRooksSource == x,
			State.MaybePieceByCoordinates.isClear (
				State.Board.getMaybePieceByCoordinates board
			) (
				Cartesian.Coordinates.kingsStartingCoordinates logicalColour
			) castlingRooksSource,
			let castlingKingsMove	= Component.CastlingMove.getKingsMove castlingMove,
			all (
				null . State.Board.findAttackersOf board logicalColour
			) $ Component.Move.interpolate castlingKingsMove	-- The King mustn't be checked anywhere alongs its route.
	] {-list-comprehension-}
	| otherwise	= [] {-have already Castled-}

-- | List any /rank/s to which the specified /piece/ can be promoted on moving to the specified /destination/.
listMaybePromotionRanks
	:: Cartesian.Coordinates.Coordinates	-- ^ Destination.
	-> Component.Piece.Piece
	-> [Maybe Attribute.Rank.Rank]
{-# INLINE listMaybePromotionRanks #-}
listMaybePromotionRanks destination piece
	| Component.Piece.isPawnPromotion piece destination	= map Just Attribute.Rank.promotionProspects
	| otherwise						= [Nothing]

-- | The type of a function which transforms a /game/.
type Transformation	= Game -> Game

{- |
	* Moves the referenced /piece/ between the specified /coordinates/.

	* As a result of the /turn/, the next logical colour is changed, the /move/s available to each player are updated, & any reason for game-termination recorded.

	* CAVEAT: no validation of the /turn/ is performed since the /move/ may have been automatically selected & therefore known to be valid.

	* CAVEAT: doesn't account for any previous game-termination when updating 'getAvailableQualifiedMovesByLogicalColour'.
-}
takeTurn :: Component.Turn.Turn -> Transformation
takeTurn turn game@MkGame {
	getNextLogicalColour				= nextLogicalColour,
	getCastleableRooksByLogicalColour		= castleableRooksByLogicalColour,
	getBoard					= board,
	getTurnsByLogicalColour				= turnsByLogicalColour,
	getInstancesByPosition				= instancesByPosition,
	getAvailableQualifiedMovesByLogicalColour	= availableQualifiedMovesByLogicalColour
} = Control.Exception.assert (
	not $ isTerminated game	-- CAVEAT: otherwise any resignation will be overwritten.
 ) game' where
	((move, moveType), sourceRank)	= (Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType) . Component.Turn.getQualifiedMove &&& Component.Turn.getRank $! turn	-- Deconstruct.
	(source, destination)		= Component.Move.getSource &&& Component.Move.getDestination $ move	-- Deconstruct.

	opponentsLogicalColour :: Colour.LogicalColour.LogicalColour
	opponentsLogicalColour	= Property.Opposable.getOpposite nextLogicalColour

	inferredRooksMove	= Data.Maybe.maybe (
		Control.Exception.throw . Data.Exception.mkSearchFailure . showString "BishBosh.Model.Game.takeTurn:\tfailed to find any Rook's move corresponding to " $ shows (move, moveType) "."
	 ) Component.CastlingMove.getRooksMove . Data.List.find (
		(== move) . Component.CastlingMove.getKingsMove
	 ) $ Component.CastlingMove.getCastlingMoves nextLogicalColour

	board'	= (
		if Attribute.MoveType.isCastle moveType
			then State.Board.movePiece inferredRooksMove $ Just Data.Default.def {-move-type for the Rook's component of the Castling-}
			else id
	 ) $ State.Board.movePiece move (Just moveType) board

	maybePieceByCoordinates'	= State.Board.getMaybePieceByCoordinates board'	-- Deconstruct.

	game' = game {
		getNextLogicalColour				= opponentsLogicalColour,
		getCastleableRooksByLogicalColour		= State.CastleableRooksByLogicalColour.takeTurn nextLogicalColour turn castleableRooksByLogicalColour,
		getBoard					= board',
		getTurnsByLogicalColour				= State.TurnsByLogicalColour.prepend nextLogicalColour turn turnsByLogicalColour,
		getMaybeChecked					= Data.List.find (State.Board.isKingChecked board') [opponentsLogicalColour],
		getInstancesByPosition				= State.InstancesByPosition.insertPosition (Component.Turn.getIsRepeatableMove turn) (mkPosition game') instancesByPosition,
		getAvailableQualifiedMovesByLogicalColour	= let
			moveEndpoints :: [Cartesian.Coordinates.Coordinates]
			moveEndpoints	= (
				case moveType of
					Attribute.MoveType.Castle _	-> (++) [
						Component.Move.getSource inferredRooksMove,
						Component.Move.getDestination inferredRooksMove
					 ] -- The move-type of a move by the Castler's opponent, to either of the corresponding Rook's end-points, has now changed.
					Attribute.MoveType.EnPassant	-> (Cartesian.Coordinates.retreat nextLogicalColour destination :)	-- An opposing piece may have been blocked by their own Pawn, which has just been taken En-passant.
					_				-> id
			 ) [source, destination]

			kingsByCoordinates :: [Component.Piece.LocatedPiece]
			kingsByCoordinates	= map (
				State.CoordinatesByRankByLogicalColour.getKingsCoordinates (State.Board.getCoordinatesByRankByLogicalColour board') &&& Component.Piece.mkKing
			 ) Property.FixedMembership.members

			affected, affected'	:: [Component.Piece.LocatedPiece]
			(affected, affected')	= (
				Data.List.nub . (:) (
					destination,
					Component.Piece.mkPiece nextLogicalColour . Data.Maybe.fromMaybe sourceRank $ Attribute.Rank.getMaybePromotionRank moveType
				) *** Data.List.nub
			 ) . Data.List.partition (
				(== nextLogicalColour) . Component.Piece.getLogicalColour . snd {-piece-}
			 ) . (
				if Component.Turn.isPawnDoubleAdvance turn nextLogicalColour
					then (++) [
						(pawnCoordinates, oppositePiece) |
							let oppositePiece	= Component.Piece.mkPiece opponentsLogicalColour sourceRank,
							pawnCoordinates	<- Cartesian.Coordinates.getAdjacents destination,
							State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) pawnCoordinates == Just oppositePiece	-- Find any opposing Pawn which can capture En-passant.
					] {-list-comprehension-}
					else id
			 ) $ kingsByCoordinates {-moves available to either King may be constrained or liberated, even if misaligned with move-endpoints-} ++ [
				(knightsCoordinates, Component.Piece.mkKnight knightsColour) |
					knightsColour		<- Property.FixedMembership.members,	-- The moves for one's own Knights may be have been blocked by a friendly piece occupying an end-point, whereas the moves for opposing Knights will have a new move-type.
					knightsCoordinates	<- concatMap (StateProperty.Seeker.findProximateKnights board' knightsColour) moveEndpoints
			 ] {-list-comprehension-} ++ (
				if sourceRank == Attribute.Rank.King
					then concatMap (
						flip (
							State.MaybePieceByCoordinates.findBlockingPieces maybePieceByCoordinates'
						) Nothing {-omni-directional-} . fst {-coordinates-}
					) kingsByCoordinates	-- Re-evaluate the moves available to all pieces aligned with a King.
					else [
						(blockingCoordinates, blockingPiece) |
							(kingsCoordinates, _)			<- kingsByCoordinates,
							direction				<- Data.Maybe.mapMaybe (Cartesian.Vector.toMaybeDirection . Cartesian.Vector.measureDistance kingsCoordinates) moveEndpoints, -- N.B. null when the King isn't aligned with any move-endpoint.
							let findBlockingPieceFrom	= flip (State.MaybePieceByCoordinates.findBlockingPiece maybePieceByCoordinates') direction,
							(blockingCoordinates, blockingPiece)	<- Data.Maybe.maybeToList $ (
								\pair@(coordinates, _) -> if coordinates /= destination
									then Just pair
									else {-blocker is destination-} if Cartesian.Vector.toMaybeDirection (Cartesian.Vector.measureDistance kingsCoordinates source) == Just direction
										then Nothing
										else findBlockingPieceFrom coordinates	-- Look through the destination to the previous blocker; which might be the source.
							) =<< findBlockingPieceFrom kingsCoordinates
					] -- List-comprehension. Re-evaluate the moves available to all pieces aligned with a King & a move-endpoint.
			 ) ++ [
				locatedAffectedPiece |
					moveEndpoint		<- moveEndpoints,
					locatedAffectedPiece	<- filter (
						not . uncurry (||) . (
							(== destination) *** uncurry (||) . (
								Component.Piece.isKnight &&& Component.Piece.isKing
							) -- Added above.
						)
					) $ State.MaybePieceByCoordinates.findBlockingPieces maybePieceByCoordinates' moveEndpoint Nothing {-omni-directional-},
					uncurry (flip Component.Piece.canMoveBetween) locatedAffectedPiece moveEndpoint
			 ] -- List-comprehension. Re-evaluate the moves available to all pieces, which either could move to the source, or can now move to the destination, of the requested move.

			insertMovesFrom	:: AvailableQualifiedMoves -> [Component.Piece.LocatedPiece] -> AvailableQualifiedMoves
			insertMovesFrom	= foldr $ \(source', piece') -> let
				logicalColour			= Component.Piece.getLogicalColour piece'
				isSafeDestination destination'	= not . State.Board.exposesKing board' logicalColour $ Component.Move.mkMove source' destination'
			 in case [
				(destination', Attribute.MoveType.EnPassant) |
					Cartesian.Coordinates.isEnPassantRank source' logicalColour,
					Component.Piece.isPawn piece',
					destination'	<- Component.Piece.findAttackDestinations piece' source',
					State.MaybePieceByCoordinates.isVacant maybePieceByCoordinates' destination',
					uncurry (&&) . (
						(== Just (Property.Opposable.getOpposite piece')) . State.MaybePieceByCoordinates.dereference maybePieceByCoordinates' &&& (== move) . Component.Move.mkMove (Cartesian.Coordinates.advance logicalColour destination')
					) $ Cartesian.Coordinates.retreat logicalColour destination',	-- Did an opposing Pawn just double-advance to the expected position ?
					isSafeDestination destination'
			 ] {-list-comprehension-} ++ [
				(
					destination',
					Attribute.MoveType.mkNormalMoveType maybeTakenRank maybePromotionRank
				) |
					(destination', maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates' source' piece',
					maybeTakenRank /= Just Attribute.Rank.King,	-- This move can never be made; the option will either be immediately removed or check-mate declared.
					isSafeDestination destination',
					maybePromotionRank		<- listMaybePromotionRanks destination' piece'
			 ] {-list-comprehension-} of
				[]			-> Map.delete source'				-- There're zero moves from here.
				qualifiedDestinations	-> Map.insert source' qualifiedDestinations	-- Overwrite any existing moves.

			insertCastlingMoves :: Colour.LogicalColour.LogicalColour -> AvailableQualifiedMoves -> AvailableQualifiedMoves
			insertCastlingMoves logicalColour	= case findAvailableCastlingMoves game' logicalColour of
				[]			-> id
				validCastlingMoves	-> uncurry (
					Map.insertWith (++)
				 ) $ (
					Component.Move.getSource {-the King-} . Component.QualifiedMove.getMove . head &&& map (
						Component.Move.getDestination . Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType
					)
				 ) validCastlingMoves
		in (
			\availableQualifiedMovesByLogicalColour' -> (
				case (Map.member opponentsLogicalColour availableQualifiedMovesByLogicalColour', Data.Maybe.isJust $ getMaybeChecked game') of
					(True, isChecked)
						| isChecked	-> Map.delete opponentsLogicalColour	-- Many changes result from the King being checked.
						| otherwise	-> Map.adjust (
							insertCastlingMoves opponentsLogicalColour . (
								`insertMovesFrom` affected'	-- Reconstruct any moves for affected pieces.
							) . (
								if Attribute.MoveType.isEnPassant moveType
									then Map.delete $ Cartesian.Coordinates.retreat nextLogicalColour destination
									else id
							) . Map.delete destination	-- Delete the moves originally available to any taken piece.
						) opponentsLogicalColour
					(_, isChecked)
						| isChecked	-> id	-- We neither want an entry in the map, nor is there one.
						| otherwise	-> Map.insert opponentsLogicalColour $ mkAvailableQualifiedMovesFor game' opponentsLogicalColour	-- Reconstruct.
			) availableQualifiedMovesByLogicalColour'
		) $ (
			if Data.Maybe.maybe True {-not a member-} (
				\availableQualifiedMoves -> sourceRank == Attribute.Rank.King || Data.Maybe.maybe False {-zero previous turns-} (
					`Component.Turn.isPawnDoubleAdvance` opponentsLogicalColour
				) (
					maybeLastTurn game	-- I.E. one's opponent.
				) {-only required for efficiency-} && Data.Foldable.any (
					any $ Attribute.MoveType.isEnPassant . snd {-moveType-}
				) availableQualifiedMoves
			) $ Map.lookup nextLogicalColour availableQualifiedMovesByLogicalColour
				then Map.insert nextLogicalColour $ mkAvailableQualifiedMovesFor game' nextLogicalColour	-- Reconstruct.
				else Map.adjust (
					insertCastlingMoves nextLogicalColour . (
						`insertMovesFrom` affected	-- Reconstruct any moves for affected pieces.
					) . Map.delete source		-- Delete the moves originally available to the moved piece.
				) nextLogicalColour
		) availableQualifiedMovesByLogicalColour,
		getMaybeTerminationReason	= inferMaybeTerminationReason game'	-- CAVEAT: this will overwrite any previous resignation.
	}

-- | Construct a /turn/ & relay the request to 'takeTurn'.
applyQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Transformation
applyQualifiedMove qualifiedMove game@MkGame { getBoard = board }
	| Just piece	<- State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) $! Component.Move.getSource move
			= takeTurn (Component.Turn.mkTurn qualifiedMove $! Component.Piece.getRank piece) game
	| otherwise	= Control.Exception.throw . Data.Exception.mkSearchFailure . showString "BishBosh.Model.Game.applyQualifiedMove:\tthere isn't a piece at the source of " . shows move . showString "; " $ shows game "."
	where
		move	= Component.QualifiedMove.getMove qualifiedMove

-- | Construct a /qualifiedMove/ & relay the request to "applyQualifiedMove".
applyEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove -> Transformation
applyEitherQualifiedMove eitherQualifiedMove game@MkGame { getBoard = board } = applyQualifiedMove (
	Component.QualifiedMove.mkQualifiedMove move . (
		State.MaybePieceByCoordinates.inferMoveType (State.Board.getMaybePieceByCoordinates board) move ||| id
	) $ Component.EitherQualifiedMove.getPromotionRankOrMoveType eitherQualifiedMove
 ) game where
	move	= Component.EitherQualifiedMove.getMove eitherQualifiedMove

-- | Constructs /eitherQualifiedMove/s from the data provided, validating & applying each in the specified order.
applyEitherQualifiedMoves
	:: (a -> Either String Component.EitherQualifiedMove.EitherQualifiedMove)	-- ^ A constructor which can return an error-message.
	-> Game										-- ^ The /game/ to which the /move/s should be sequentially applied.
	-> [a]										-- ^ An ordered sequence of data from which /move/s are constructed.
	-> Either (a, String) Game							-- ^ Either a rogue datum & the corresponding error-message, or the resulting /game/.
applyEitherQualifiedMoves moveConstructor	= Data.Foldable.foldl' (
	\eitherGame datum -> eitherGame >>= (
		\game -> Left . (,) datum {-Constructor failed-} ||| (
			\eitherQualifiedMove -> Data.Maybe.maybe (
				Right $ applyEitherQualifiedMove eitherQualifiedMove game
			) (
				\errorMessage -> Left (
					datum,
					showString "board" . Text.ShowList.showsAssociation . shows (getBoard game) . showString " (" $ shows errorMessage ")"
				) -- Pair.
			) $ validateEitherQualifiedMove game eitherQualifiedMove
		) $ moveConstructor datum
	)
 ) . Right

{- |
	* True if the specified /move/ is valid, given the implied /piece/ & the current state of the /game/.

	* N.B.: it is considered valid to take a @King@, one just never has the opportunity, since the game terminates the move before.
-}
validateQualifiedMove
	:: Game	-- ^ Prior to playing the /qualified move/.
	-> Component.QualifiedMove.QualifiedMove
	-> Maybe String	-- ^ Error-message.
validateQualifiedMove game@MkGame {
	getNextLogicalColour		= nextLogicalColour,
	getBoard			= board,
	getMaybeChecked			= maybeChecked,
	getMaybeTerminationReason	= maybeTerminationReason
} qualifiedMove = Control.Exception.assert (
	StateProperty.Censor.hasBothKings (
		State.Board.getCoordinatesByRankByLogicalColour board
	) && maybeChecked == Data.List.find (State.Board.isKingChecked board) Property.FixedMembership.members
 ) $ Data.Maybe.maybe (
	Data.Maybe.maybe (
		Just "there isn't a piece at the specified source-coordinates"	-- N.B.: this is also caught by 'validateEitherQualifiedMove'.
	) (
		\sourcePiece -> let
			sourceLogicalColour	= Component.Piece.getLogicalColour sourcePiece	-- Deconstruct.
		in lookup True $ Data.Maybe.maybe id (
			\destinationPiece -> (++) [
				(
					Component.Piece.isKing destinationPiece,			-- N.B.: this would otherwise prevent construction of the move-type.
					showString "a '" $ shows destinationPiece "' can't be taken"	-- N.B.: one should never be in a position where this can arise.
				), (
					Component.Piece.isFriend destinationPiece sourcePiece,
					showString "your own '" $ shows destinationPiece "' occupies the requested destination"
				)
			] -- Tests which depend on any taken piece.
		) maybeDestinationPiece [
			(
				sourceLogicalColour /= nextLogicalColour,
				showString "it's " . shows nextLogicalColour . showString "'s turn, but the referenced piece is " $ show sourceLogicalColour
			), (
				Attribute.MoveType.isPromotion moveType && not (Component.Piece.isPawn sourcePiece),
				showString "only a '" $ shows (Component.Piece.mkPawn sourceLogicalColour) "' can be promoted"
			)
		] {-tests which are independent of the type of the moving piece-} ++ map (
			Control.Arrow.second $ showString "regarding moving your '" . shows sourcePiece . showString "', "	-- Provide context.
		) (
			(
				case Component.Piece.getRank sourcePiece of
					Attribute.Rank.Pawn
						| destination `elem` Component.Piece.findAttackDestinations sourcePiece source	-> Data.Maybe.maybe (
							let
								opponentsCoordinates	= Cartesian.Coordinates.retreat sourceLogicalColour destination
								opponentsPawn		= Property.Opposable.getOpposite sourcePiece
							in [
								(
									not $ Cartesian.Coordinates.isEnPassantRank source sourceLogicalColour,
									showString "one can't take a '" $ shows opponentsPawn "' en-passant, from this rank"
								), (
									State.MaybePieceByCoordinates.isOccupied maybePieceByCoordinates destination,
									showString "taking a '" $ shows opponentsPawn "' en-passant, requires a move to a vacant square"
								), (
									State.MaybePieceByCoordinates.dereference maybePieceByCoordinates opponentsCoordinates /= Just opponentsPawn,
									shows "en-passant" . showString " requires a '" $ shows opponentsPawn "' to be taken"
								), (
									Data.Maybe.maybe True {-zero previous turns-} (
										(
											/= Component.Move.mkMove (Cartesian.Coordinates.advance sourceLogicalColour destination) opponentsCoordinates
										) . Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove
									) $ maybeLastTurn game,
									showString "a '" $ shows opponentsPawn "' can only be taken en-passant, immediately after it has advanced two squares"
								)
							] -- En-Passant.
						) (
							const []	-- The Pawn is moving diagonally forwards, to a square occupied by the opponent's piece => valid.
						) maybeDestinationPiece
						| otherwise {-advance-}	-> (
							Cartesian.Vector.getXDistance distance /= 0,
							"it may only have a sideways component during attack"
						) : (
							case (
								if Colour.LogicalColour.isBlack sourceLogicalColour
									then negate
									else id
							) $ Cartesian.Vector.getYDistance distance of
								1	-> id
								2	-> (++) [
									(
										not $ Cartesian.Coordinates.isPawnsFirstRank source sourceLogicalColour,
										"it only has the option to advance two squares on its first move"
									), (
										isObstructed,
										"an obstruction can't be jumped"
									)
								 ]
								nSquares	-> (:) (
									True,
									if nSquares == 0
										then "it must advance"
										else if nSquares > 0
											then showString "it can't advance " $ shows nSquares " squares"
											else "it can't retreat"
								 )
						) [
							(
								Data.Maybe.isJust maybeDestinationPiece,
								"an advance must be to a vacant square"
							)
						] -- Singleton.
					Attribute.Rank.Rook	-> [
						(
							not $ Property.Orientated.isParallel move,
							"only moves parallel to the edges of the board are permissible"
						), (
							isObstructed,
							"an obstruction can't be jumped"
						)
					 ]
					Attribute.Rank.Knight	-> [
						(
							distance `notElem` Cartesian.Vector.attackVectorsForKnight,
							"the jump must be to the opposite corner of a 3 x 2 rectangle"
						) -- Pair.
					 ]
					Attribute.Rank.Bishop	-> [
						(
							not $ Property.Orientated.isDiagonal move,
							"only moves diagonal to the edges of the board are permissible"
						), (
							isObstructed,
							"an obstruction can't be jumped"
						)
					 ]
					Attribute.Rank.Queen	-> [
						(
							not $ Property.Orientated.isStraight move,
							"only straight moves are permissible"
						), (
							isObstructed,
							"an obstruction can't be jumped"
						)
					 ]
					Attribute.Rank.King
						| distance `elem` Cartesian.Vector.attackVectorsForKing	-> []	-- i.e. a normal move.
						| otherwise {-castling-}				-> Data.Maybe.maybe [
							(
								True,	-- i.e. validation-failure.
								"it can only castle (move two squares left or right from its starting position), or move one square in any direction"
							) -- Pair.
						] (
							(
								\rooksSource -> [
									(
										not $ State.CastleableRooksByLogicalColour.canCastleWith (getCastleableRooksByLogicalColour game) sourceLogicalColour rooksSource,
										showString "it has either already castled or lost the right to castle with the implied '" $ shows (Component.Piece.mkRook sourceLogicalColour) "'"
									), (
										State.MaybePieceByCoordinates.isObstructed maybePieceByCoordinates source rooksSource,
										"it can't castle through an obstruction"
									)
								]
							) . Component.Move.getSource . Component.CastlingMove.getRooksMove
						) (
							Data.List.find (
								(== move) . Component.CastlingMove.getKingsMove
							) $ Component.CastlingMove.getCastlingMoves sourceLogicalColour

						) ++ [
							(
								maybeChecked == Just sourceLogicalColour,
								"it can't castle out of check"
							), (
								not . all (
									null . State.Board.findAttackersOf board sourceLogicalColour
								) $ Component.Move.interpolate move,	-- The King mustn't pass through check when moving from source to destination (inclusive); a long castle still permits the square right of the Rook to be checked.
								"it can't castle through check"
							)
						] -- Tests which are independent of the implied Rook.
			) {-rank-specific test-} ++ [
				Control.Arrow.second (
					if Component.Piece.isKing sourcePiece
						then showString "it"
						else showString "your '" . shows (Component.Piece.mkKing sourceLogicalColour) . showChar '\''
				) $ if maybeChecked == Just sourceLogicalColour
					then (
						State.Board.isKingChecked (State.Board.movePiece move (Just moveType) board) sourceLogicalColour,	-- CAVEAT: don't perform an unvalidated move at the Game-level.
						" remains checked"
					) -- Pair.
					else (
						State.Board.exposesKing board sourceLogicalColour move,
						" would become exposed"
					) -- Pair.
			] -- Post-move tests on one's King.
		)
	) $ State.MaybePieceByCoordinates.dereference maybePieceByCoordinates source
 ) (
	Just . show	-- The game has been terminated, so there aren't any valid moves.
 ) maybeTerminationReason where
	(move, moveType)	= Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType $ qualifiedMove
	(source, destination)	= Component.Move.getSource &&& Component.Move.getDestination $ move	-- Deconstruct.
	maybePieceByCoordinates	= State.Board.getMaybePieceByCoordinates board
	maybeDestinationPiece	= State.MaybePieceByCoordinates.dereference maybePieceByCoordinates destination	-- Query.
	distance		= Component.Move.measureDistance move

	isObstructed :: Bool
	isObstructed	= State.MaybePieceByCoordinates.isObstructed maybePieceByCoordinates source destination

-- | Validates the /move-type/ then forwards the request to 'validateQualifiedMove'.
validateEitherQualifiedMove
	:: Game	-- ^ Prior to playing the /move/.
	-> Component.EitherQualifiedMove.EitherQualifiedMove
	-> Maybe String	-- ^ Error-message.
validateEitherQualifiedMove game@MkGame { getBoard = board } eitherQualifiedMove
	| State.MaybePieceByCoordinates.isVacant maybePieceByCoordinates (
		Component.Move.getSource move
	)		= Just "there isn't a piece at the specified source-coordinates"	-- Guard the call to 'State.MaybePieceByCoordinates.inferMoveType'.
	| Right moveType	<- promotionRankOrMoveType
	, moveType /= inferredMoveType		= Just . showString "the implied " . showString Attribute.MoveType.tag . Text.ShowList.showsAssociation . shows moveType . showString " /= " $ show inferredMoveType
	| otherwise				= validateQualifiedMove game $ Component.QualifiedMove.mkQualifiedMove move inferredMoveType
	where
		(move, promotionRankOrMoveType)	= Component.EitherQualifiedMove.getMove &&& Component.EitherQualifiedMove.getPromotionRankOrMoveType $ eitherQualifiedMove

		maybePieceByCoordinates		= State.Board.getMaybePieceByCoordinates board

		inferredMoveType :: Attribute.MoveType.MoveType
		inferredMoveType	= State.MaybePieceByCoordinates.inferMoveType maybePieceByCoordinates move $ (
			id ||| Attribute.Rank.getMaybePromotionRank
		 ) promotionRankOrMoveType	-- Discard any move-type.

-- | Whether the specified /QualifiedMove/ is valid.
isValidQualifiedMove :: Game -> Component.QualifiedMove.QualifiedMove -> Bool
isValidQualifiedMove game	= Data.Maybe.isNothing . validateQualifiedMove game

-- | Whether the specified /EitherQualifiedMove/ is valid.
isValidEitherQualifiedMove :: Game -> Component.EitherQualifiedMove.EitherQualifiedMove -> Bool
isValidEitherQualifiedMove game	= Data.Maybe.isNothing . validateEitherQualifiedMove game

{- |
	* Roll-back the specified /game/ until the start, returning each previous /game/ paired with the /ply/ which was then made.

	* The list-head contains the most recent /ply/, while the tail contains the first.
-}
rollBack :: Game -> [(Game, Component.Turn.Turn)]
rollBack	= Data.List.unfoldr (
	\game@MkGame {
		getNextLogicalColour	= nextLogicalColour,
		getBoard		= board,
		getTurnsByLogicalColour	= turnsByLogicalColour,
		getInstancesByPosition	= instancesByPosition
	} -> let
		previousColour	= Property.Opposable.getOpposite nextLogicalColour
	 in case State.TurnsByLogicalColour.dereference turnsByLogicalColour previousColour of
		turn : previousTurns	-> let
			(move, moveType)	= (Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType) $ Component.Turn.getQualifiedMove turn	-- Deconstruct.
			destination		= Component.Move.getDestination move	-- Deconstruct.

			game'@MkGame {
				getBoard		= board',
				getTurnsByLogicalColour	= turnsByLogicalColour',
				getMaybeChecked		= maybeChecked'
			} = game {
				getNextLogicalColour				= previousColour,
				getCastleableRooksByLogicalColour		= State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour turnsByLogicalColour',
				getMaybeChecked					= Data.List.find (State.Board.isKingChecked board') [previousColour],
				getBoard					= (
					case moveType of
						Attribute.MoveType.Castle isShort	-> State.Board.movePiece (
							uncurry Component.Move.mkMove $ (
								Cartesian.Coordinates.translateX (
									if isShort then pred else succ
								) {-rook's source relative to the King-} &&& Cartesian.Coordinates.translateX (
									const $ if isShort then Cartesian.Abscissa.xMax else Cartesian.Abscissa.xMin
								) {-rook's destination-}
							) destination
						 ) $ Just Data.Default.def {-move-type-}	-- CAVEAT: this is only the Rook's part of the Castling.
						Attribute.MoveType.EnPassant		-> StateProperty.Mutator.placePiece (
							Component.Piece.mkPawn nextLogicalColour
						 ) $ Cartesian.Coordinates.advance nextLogicalColour destination	-- Re-instate the opponent's passing Pawn.
						_ {-normal-}
							| Attribute.MoveType.isPromotion moveType	-> StateProperty.Mutator.placePiece (
								Component.Piece.mkPawn previousColour	-- Demote the piece just returned to the source of the move.
							) $ Component.Move.getSource move
							| otherwise					-> id
				 ) . Data.Maybe.maybe id (
					(`StateProperty.Mutator.placePiece` destination) . Component.Piece.mkPiece nextLogicalColour
				 ) (
					Attribute.MoveType.getMaybeExplicitlyTakenRank moveType	-- Reconstruct any piece taken (except en-passant), inferring the logical colour.
				 ) $ State.Board.movePiece (Property.Opposable.getOpposite move) Nothing {-MoveType-} board,	-- N.B.: operate directly on the board to avoid creating a new Turn in the Game-structure.
				getTurnsByLogicalColour				= State.TurnsByLogicalColour.update [(previousColour, previousTurns)] turnsByLogicalColour,
				getInstancesByPosition				= if Component.Turn.getIsRepeatableMove turn
					then State.InstancesByPosition.deletePosition (mkPosition game) instancesByPosition
					else mkInstancesByPosition game',	-- Reconstruct the map prior to the unrepeatable move.
				getAvailableQualifiedMovesByLogicalColour	= Map.fromAscList [
					id &&& mkAvailableQualifiedMovesFor game' $ logicalColour |
						logicalColour	<- Property.FixedMembership.members,
						maybeChecked' /= Just logicalColour
				], -- List-comprehension.
				getMaybeTerminationReason			= Nothing
			}
		 in Just ((game', turn), game')
		_	-> Nothing
 )

{- |
	* List all the /move/s available to the specified player; which may not be the player who is required to move next.

	* CAVEAT: to avoid an infinite loop, this doesn't check whether the game has already terminated.
-}
listQualifiedMovesAvailableTo
	:: Game
	-> Colour.LogicalColour.LogicalColour	-- ^ Define the player for whom the moves are required.
	-> [Component.QualifiedMove.QualifiedMove]
listQualifiedMovesAvailableTo game@MkGame {
	getBoard	= board,
	getMaybeChecked	= maybeChecked
} logicalColour
	| maybeChecked == Just logicalColour = let
		kingsCoordinates	= State.CoordinatesByRankByLogicalColour.getKingsCoordinates coordinatesByRankByLogicalColour logicalColour
	in [
		Component.QualifiedMove.mkQualifiedMove move moveType |
			(destination, maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates kingsCoordinates $ Component.Piece.mkKing logicalColour,
			let
				move		= Component.Move.mkMove kingsCoordinates destination
				moveType	= Attribute.MoveType.mkNormalMoveType maybeTakenRank Nothing {-promotion-rank-},
			null $ State.Board.findAttackersOf (State.Board.movePiece move (Just moveType) board) logicalColour destination -- Avoid moving the King into another check. CAVEAT: one can't merely use 'Board.exposesKing' since that assumes that one isn't already checked.
	] {-list-comprehension-} ++ case State.Board.findAttackersOf board logicalColour kingsCoordinates of
		[(checkedFrom, checkedByRank)]	-> Control.Exception.assert (checkedByRank /= Attribute.Rank.King) . filter isSafeQualifiedMove $ (
			if checkedByRank == Attribute.Rank.Pawn
				then Data.Maybe.maybe [] {-CAVEAT: this can occur if the game has just been read from FEN-} (
					(
						\lastMove -> let
							lastDestination	= Component.Move.getDestination lastMove
							pawn		= Component.Piece.mkPawn logicalColour
						in [
							Component.QualifiedMove.mkQualifiedMove (
								Component.Move.mkMove source $ Cartesian.Coordinates.advance logicalColour lastDestination	-- Construct a move which takes the attacker.
							) Attribute.MoveType.enPassant |
								Component.Move.isPawnDoubleAdvance lastMove opponentsLogicalColour,
								source	<- Cartesian.Coordinates.getAdjacents lastDestination,
								State.MaybePieceByCoordinates.dereference maybePieceByCoordinates source == Just pawn
						] -- List-comprehension.
					) . Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove
				) $ maybeLastTurn game	-- The King is checked by a Pawn, which must also have been the last piece to move.
				else [] -- The King is checked by a piece other than a Pawn, so even if one can legitimately take en-passant, it won't resolve the issue.
		 ) ++ [
			Component.QualifiedMove.mkQualifiedMove (
				Component.Move.mkMove source checkedFrom	-- Construct a move which takes the attacker.
			) $ Attribute.MoveType.mkNormalMoveType (Just checkedByRank) maybePromotionRank |
				(source, attackersRank)	<- State.Board.findAttackersOf board opponentsLogicalColour checkedFrom,	-- See if the attacker can be taken (excluding en-passant).
				attackersRank /= Attribute.Rank.King,	-- The King can take its attacker, but it's already addressed above.
				maybePromotionRank	<- listMaybePromotionRanks checkedFrom {-destination-} $ Component.Piece.mkPiece logicalColour attackersRank
		 ] {-list-comprehension-} ++ [
			Component.QualifiedMove.mkQualifiedMove (
				Component.Move.mkMove source destination
			) $ Attribute.MoveType.mkNormalMoveType Nothing {-taken rank-} maybePromotionRank |
				checkedByRank /= Attribute.Rank.Knight,	-- A Knight can't be blocked.
				rank			<- Attribute.Rank.expendable,	-- Find pieces that might be able to block the checking piece.
				let piece	= Component.Piece.mkPiece logicalColour rank,
				source			<- State.CoordinatesByRankByLogicalColour.dereference coordinatesByRankByLogicalColour logicalColour rank,	-- Find the source of a potential blocking move.
				(destination, Nothing)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates source piece,	-- The blocker must move to an empty square, otherwise the checker was already blocked.
				Control.Exception.assert (checkedFrom /= kingsCoordinates) . elem destination . init {-drop King's location-} $ Cartesian.Coordinates.interpolate checkedFrom kingsCoordinates,
				maybePromotionRank	<- listMaybePromotionRanks destination piece
		 ] -- List-comprehension.
		attackers		-> Control.Exception.assert (
			length attackers == 2	-- Triple-check isn't possible.
		 ) []	-- If checked by more than one piece, then the King must be moved; see options above.
	| otherwise {-not checked-}	= findAvailableCastlingMoves game logicalColour ++ filter isSafeQualifiedMove (
		[
			Component.QualifiedMove.mkQualifiedMove (
				Component.Move.mkMove source destination
			) Attribute.MoveType.enPassant |
				let pawn	= Component.Piece.mkPawn logicalColour,
				source		<- State.CoordinatesByRankByLogicalColour.dereference coordinatesByRankByLogicalColour logicalColour Attribute.Rank.Pawn,
				Cartesian.Coordinates.isEnPassantRank source logicalColour,
				destination	<- Component.Piece.findAttackDestinations pawn source,
				State.MaybePieceByCoordinates.isVacant maybePieceByCoordinates destination,
				let opponentsCoordinates	= Cartesian.Coordinates.retreat logicalColour destination,
				State.MaybePieceByCoordinates.dereference maybePieceByCoordinates opponentsCoordinates == Just (Property.Opposable.getOpposite pawn),
				Data.Maybe.maybe False {-zero previous turns-} (
					uncurry (&&) . (
						(== opponentsCoordinates) . Component.Move.getDestination &&& (
							== Cartesian.Coordinates.advance logicalColour destination
						) . Component.Move.getSource
					 ) . Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove
				) $ maybeLastTurn game
		] {-List-comprehension. Include en-passant moves-} ++ [
			Component.QualifiedMove.mkQualifiedMove (
				Component.Move.mkMove source destination
			) $ Attribute.MoveType.mkNormalMoveType maybeTakenRank maybePromotionRank |
				(source, piece)			<- State.CoordinatesByRankByLogicalColour.findPiecesOfColour coordinatesByRankByLogicalColour logicalColour,
				(destination, maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates source piece,
				maybeTakenRank /= Just Attribute.Rank.King,	-- This move can never be made; the option will either be immediately removed or check-mate declared.
				maybePromotionRank		<- listMaybePromotionRanks destination piece
		] -- List-comprehension.
	)
	where
		opponentsLogicalColour						= Property.Opposable.getOpposite logicalColour
		(maybePieceByCoordinates, coordinatesByRankByLogicalColour)	= State.Board.getMaybePieceByCoordinates &&& State.Board.getCoordinatesByRankByLogicalColour $ board
		isSafeQualifiedMove qualifiedMove				= not . State.Board.exposesKing board logicalColour $ Component.QualifiedMove.getMove qualifiedMove

-- | Construct 'AvailableQualifiedMoves' for the player of the specified /logical colour/.
mkAvailableQualifiedMovesFor :: Game -> Colour.LogicalColour.LogicalColour -> AvailableQualifiedMoves
mkAvailableQualifiedMovesFor game	= foldr {-maintains destination-order-} (
	\qualifiedMove -> let
		move	= Component.QualifiedMove.getMove qualifiedMove
	in Map.insertWith (++) (
		Component.Move.getSource move	-- Key.
	) [
		(
			Component.Move.getDestination move,
			Component.QualifiedMove.getMoveType qualifiedMove
		) -- Pair.
	] {-singleton-}
 ) Property.Empty.empty . listQualifiedMovesAvailableTo game

{- |
	* Retrieve the recorded value, or generate the list of /move/s available to the player of the specified /logical colour/.

	* CAVEAT: doesn't account for game-termination.
-}
findQualifiedMovesAvailableTo
	:: Game
	-> Colour.LogicalColour.LogicalColour
	-> [Component.QualifiedMove.QualifiedMove]
findQualifiedMovesAvailableTo game@MkGame { getAvailableQualifiedMovesByLogicalColour = availableQualifiedMovesByLogicalColour } logicalColour
	| Just availableQualifiedMoves <- Map.lookup logicalColour availableQualifiedMovesByLogicalColour	= [
		Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) moveType |
			(source, qualifiedDestinations)	<- Map.toList availableQualifiedMoves,
			(destination, moveType)		<- qualifiedDestinations
	] -- List-comprehension.
	| otherwise	= listQualifiedMovesAvailableTo game logicalColour	-- Generate the list of moves for this player.

-- | Count the number of plies available to the specified player.
countPliesAvailableTo :: Game -> Colour.LogicalColour.LogicalColour -> Type.Count.NPlies
countPliesAvailableTo game@MkGame { getAvailableQualifiedMovesByLogicalColour = availableQualifiedMovesByLogicalColour } logicalColour
	| isTerminated game	= 0
	| Just availableQualifiedMoves	<- Map.lookup logicalColour availableQualifiedMovesByLogicalColour	-- N.B.: 'findQualifiedMovesAvailableToNextPlayer' unnecessarily constructs a list.
	= fromIntegral $ Data.Foldable.foldl' (\acc -> (+ acc) . length) 0 availableQualifiedMoves
	| otherwise		= fromIntegral . length $ listQualifiedMovesAvailableTo game logicalColour

-- | Retrieve the recorded value, or generate the list of /move/s available to the next player.
findQualifiedMovesAvailableToNextPlayer :: Game -> [Component.QualifiedMove.QualifiedMove]
findQualifiedMovesAvailableToNextPlayer game@MkGame { getNextLogicalColour = nextLogicalColour }	= findQualifiedMovesAvailableTo game nextLogicalColour

-- | Let the specified player resign.
resignationBy :: Colour.LogicalColour.LogicalColour -> Transformation
resignationBy logicalColour game
	| isTerminated game	= game	-- Already terminated.
	| otherwise		= game {
		getMaybeTerminationReason	= Just $ Rule.GameTerminationReason.mkResignation logicalColour
	}

-- | Resignation by the player who currently holds the choice of /move/.
resign :: Transformation
resign game@MkGame { getNextLogicalColour = nextLogicalColour }	= resignationBy nextLogicalColour game

-- | Agree to a draw.
agreeToADraw :: Transformation
agreeToADraw game
	| isTerminated game	= game	-- Already terminated.
	| otherwise		= game {
		getMaybeTerminationReason	= Just $ Rule.GameTerminationReason.mkDraw Rule.DrawReason.byAgreement
	}

-- | Whether the game has been terminated.
isTerminated :: Game -> Bool
isTerminated MkGame { getMaybeTerminationReason	= maybeTerminationReason }	= Data.Maybe.isJust maybeTerminationReason

{- |
	* Inspects the current state of the /board/ to infer any reason for termination.

	* N.B.: resignation isn't included, because it leaves no evidence on the board.
-}
inferMaybeTerminationReason :: Game -> Maybe Rule.GameTerminationReason.GameTerminationReason
inferMaybeTerminationReason game@MkGame {
	getBoard		= board,
	getInstancesByPosition	= instancesByPosition
}
	| haveZeroMoves
	, Just logicalColour <- getMaybeChecked game	= Just $ Rule.GameTerminationReason.mkCheckMate logicalColour
	| otherwise					= Rule.GameTerminationReason.mkDraw <$> maybeDrawReason
	where
		haveZeroMoves :: Bool
		haveZeroMoves	= null $ findQualifiedMovesAvailableToNextPlayer game

		maybeDrawReason :: Maybe Rule.DrawReason.DrawReason
		maybeDrawReason
			| haveZeroMoves																= Just Rule.DrawReason.staleMate
			| State.InstancesByPosition.anyInstancesByPosition (== Rule.DrawReason.maximumConsecutiveRepeatablePositions) instancesByPosition	= Just Rule.DrawReason.fiveFoldRepetition
			| State.InstancesByPosition.countConsecutiveRepeatablePlies instancesByPosition == Rule.DrawReason.maximumConsecutiveRepeatablePlies	= Just Rule.DrawReason.seventyFiveMoveRule
			| StateProperty.Censor.hasInsufficientMaterial $ State.Board.getCoordinatesByRankByLogicalColour board					= Just Rule.DrawReason.insufficientMaterial
			| otherwise																= Nothing

-- | Provided that the game hasn't already terminated, update the termination-reason according to whether the specified result implies either a /draw by agreement/ or a /resignation/.
updateTerminationReasonWith :: Rule.Result.Result -> Transformation
updateTerminationReasonWith result game
	| Just victorsLogicalColour <- Rule.Result.findMaybeVictor result	= resignationBy (Property.Opposable.getOpposite victorsLogicalColour) game
	| otherwise								= agreeToADraw game

-- | Forwards request to "State.CastleableRooksByLogicalColour".
cantConverge :: Game -> Game -> Bool
cantConverge MkGame {
	getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour
} MkGame {
	getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour'
} = State.CastleableRooksByLogicalColour.cantConverge castleableRooksByLogicalColour castleableRooksByLogicalColour'

-- | Constructor.
mkPosition :: Game -> State.Position.Position
mkPosition game@MkGame {
	getNextLogicalColour			= nextLogicalColour,
	getBoard				= board,
	getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour
} = State.Position.mkPosition nextLogicalColour (State.Board.getMaybePieceByCoordinates board) castleableRooksByLogicalColour $ maybeLastTurn game

-- | Constructor. Count the instances of each repeatable /position/.
mkInstancesByPosition :: Game -> InstancesByPosition
mkInstancesByPosition game	= State.InstancesByPosition.mkInstancesByPosition mkPosition . (game :) . map fst {-game-} . takeWhile (
	Component.Turn.getIsRepeatableMove . snd {-turn-}
 ) $ rollBack game

{- |
	* Whether the specified /game/'s /position/s have converged, & despite perhaps having reached this /position/ from different /move/-sequences, now have equal opportunities.

	* CAVEAT: this is different from equality.

	* CAVEAT: this test doesn't account for the possibility that one game may more quickly be drawn according to either the "Seventy-five-move Rule" or "Five-fold Repetition".

	* CAVEAT: though convenient, this function shouldn't be called for repeated tests against a constant /position/, resulting in unnecessary repeated construction of that /position/.
-}
(=~) :: Game -> Game -> Bool
game =~ game'	= mkPosition game == mkPosition game'

-- | Whether the state of the specified /game/s is different.
(/~) :: Game -> Game -> Bool
game /~ game'	= not $ game =~ game'

-- | Update the /position-hash/ of the /game/ prior to application of the last /move/.
updateIncrementalPositionHash
	:: Data.Bits.Bits positionHash
	=> Game		-- ^ The /game/ before application of the last move.
	-> positionHash	-- ^ The value before application of the last move.
	-> Game		-- ^ The current game.
	-> Component.Zobrist.Zobrist positionHash
	-> positionHash
{-# SPECIALISE updateIncrementalPositionHash :: Game -> Type.Crypto.PositionHash -> Game -> Component.Zobrist.Zobrist Type.Crypto.PositionHash -> Type.Crypto.PositionHash #-}
updateIncrementalPositionHash game positionHash game' zobrist	= StateProperty.Hashable.combine positionHash . (++) randomsFromMoveType . (
	let
		(castleableRooksByLogicalColour, castleableRooksByLogicalColour')	= ($ game) &&& ($ game') $ getCastleableRooksByLogicalColour
	in if isCastle || castleableRooksByLogicalColour /= castleableRooksByLogicalColour'
		then (
			State.CastleableRooksByLogicalColour.listIncrementalRandoms zobrist castleableRooksByLogicalColour castleableRooksByLogicalColour' ++
		) -- Section.
		else id
 ) $ [
	random |
		Just enPassantAbscissa	<- map (
			\g -> maybeLastTurn g >>= State.EnPassantAbscissa.mkMaybeEnPassantAbscissa (
				getNextLogicalColour g
			) (
				State.Board.getMaybePieceByCoordinates $ getBoard g
			) -- CAVEAT: accounts for any change to the En-passant option, rather than the act of taking En-passant.
		) [game, game'],
		random			<- StateProperty.Hashable.listRandoms zobrist enPassantAbscissa
 ] {-list-comprehension-} ++ Component.Zobrist.getRandomForBlacksMove zobrist : [
	Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (lastLogicalColour, rankAccessor turn, coordinatesAccessor move) |
		(rankAccessor, coordinatesAccessor)	<- zip [Component.Turn.getRank, (`Data.Maybe.fromMaybe` Attribute.Rank.getMaybePromotionRank moveType) . Component.Turn.getRank] coordinatesAccessors
 ] {-list-comprehension-} where
	lastLogicalColour	= getNextLogicalColour game
	turn			= Data.Maybe.fromMaybe (
		Control.Exception.throw $ Data.Exception.mkNullDatum "BishBosh.Model.Game.updateIncrementalPositionHash:\tzero turns have been made."
	 ) $ maybeLastTurn game'
	(move, moveType)	= Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType $ Component.Turn.getQualifiedMove turn
	isCastle		= Attribute.MoveType.isCastle moveType
	coordinatesAccessors	= [Component.Move.getSource, Component.Move.getDestination]

	randomsFromMoveType
		| Just rank <- Attribute.MoveType.getMaybeExplicitlyTakenRank moveType	= [Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (nextLogicalColour, rank, destination)] -- Singleton.
		| isCastle	= map (
			\coordinatesAccessor	-> Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (
				lastLogicalColour,
				Attribute.Rank.Rook,
				Data.Maybe.maybe (
					Control.Exception.throw $ Data.Exception.mkSearchFailure "BishBosh.Model.Game.updateIncrementalPositionHash.randomsFromMoveType:\tfailed to find castling-move."
				) (
					coordinatesAccessor . Component.CastlingMove.getRooksMove
				) . Data.List.find (
					(== move) . Component.CastlingMove.getKingsMove
				) $ Component.CastlingMove.getCastlingMoves lastLogicalColour
			)
		) coordinatesAccessors
		| Attribute.MoveType.isEnPassant moveType	= [Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (nextLogicalColour, Attribute.Rank.Pawn, Cartesian.Coordinates.advance nextLogicalColour destination)] -- Singleton.
		| otherwise	= []
		where
			nextLogicalColour	= getNextLogicalColour game'
			destination		= Component.Move.getDestination move