{-
	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.LogicalColour		as Attribute.LogicalColour
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.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 :: AvailableQualifiedMoves -> AvailableQualifiedMoves
sortAvailableQualifiedMoves	= ([(Coordinates, MoveType)] -> [(Coordinates, MoveType)])
-> AvailableQualifiedMoves -> AvailableQualifiedMoves
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([(Coordinates, MoveType)] -> [(Coordinates, MoveType)])
 -> AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> (((Coordinates, MoveType)
     -> (Coordinates, MoveType) -> Ordering)
    -> [(Coordinates, MoveType)] -> [(Coordinates, MoveType)])
-> ((Coordinates, MoveType) -> (Coordinates, MoveType) -> Ordering)
-> AvailableQualifiedMoves
-> AvailableQualifiedMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates, MoveType) -> (Coordinates, MoveType) -> Ordering)
-> [(Coordinates, MoveType)] -> [(Coordinates, MoveType)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((Coordinates, MoveType) -> (Coordinates, MoveType) -> Ordering)
 -> AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> ((Coordinates, MoveType) -> (Coordinates, MoveType) -> Ordering)
-> AvailableQualifiedMoves
-> AvailableQualifiedMoves
forall a b. (a -> b) -> a -> b
$ ((Coordinates, MoveType) -> Coordinates)
-> (Coordinates, MoveType) -> (Coordinates, MoveType) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (Coordinates, MoveType) -> Coordinates
forall a b. (a, b) -> a
fst {-destination-}

-- | The /move/s available to both players.
type AvailableQualifiedMovesByLogicalColour	= Map.Map Attribute.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 {
	Game -> LogicalColour
getNextLogicalColour				:: Attribute.LogicalColour.LogicalColour,				-- ^ N.B.: can be derived from 'getTurnsByLogicalColour', unless 'Property.Reflectable.reflectOnX' has been called.
	Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour		:: State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour,	-- ^ Those @Rook@s which can still participate in castling.
	Game -> Board
getBoard					:: State.Board.Board,							-- ^ The current state of the /board/.
	Game -> TurnsByLogicalColour
getTurnsByLogicalColour				:: State.CastleableRooksByLogicalColour.TurnsByLogicalColour,		-- ^ Successive /move/s & any /piece/ taken, recorded by player.
	Game -> Maybe LogicalColour
getMaybeChecked					:: Maybe Attribute.LogicalColour.LogicalColour,				-- ^ The player (if any), whose currently /checked/; which will typically be 'getNextLogicalColour', but 'listQualifiedMovesAvailableTo' can be called for either player.
	Game -> InstancesByPosition
getInstancesByPosition				:: InstancesByPosition,							-- ^ The number of instances of various positions since the last unrepeatable move.
	Game -> AvailableQualifiedMovesByLogicalColour
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.
	Game -> Maybe GameTerminationReason
getMaybeTerminationReason			:: Maybe Rule.GameTerminationReason.GameTerminationReason		-- ^ The reason (where appropriate) why the game was terminated.
}

instance Eq Game where
	MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		getBoard :: Game -> Board
getBoard					= Board
board,
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour				= TurnsByLogicalColour
turnsByLogicalColour,
		getMaybeChecked :: Game -> Maybe LogicalColour
getMaybeChecked					= Maybe LogicalColour
maybeChecked,
		getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition				= InstancesByPosition
instancesByPosition,
		getAvailableQualifiedMovesByLogicalColour :: Game -> AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour,
		getMaybeTerminationReason :: Game -> Maybe GameTerminationReason
getMaybeTerminationReason			= Maybe GameTerminationReason
maybeTerminationReason
	} == :: Game -> Game -> Bool
== MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour',
		getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour
castleableRooksByLogicalColour',
		getBoard :: Game -> Board
getBoard					= Board
board',
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour				= TurnsByLogicalColour
turnsByLogicalColour',
		getMaybeChecked :: Game -> Maybe LogicalColour
getMaybeChecked					= Maybe LogicalColour
maybeChecked',
		getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition				= InstancesByPosition
instancesByPosition',
		getAvailableQualifiedMovesByLogicalColour :: Game -> AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour',
		getMaybeTerminationReason :: Game -> Maybe GameTerminationReason
getMaybeTerminationReason			= Maybe GameTerminationReason
maybeTerminationReason'
	} = (
		LogicalColour
nextLogicalColour,
		CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		Board
board,
		TurnsByLogicalColour
turnsByLogicalColour,
		Maybe LogicalColour
maybeChecked,
		InstancesByPosition
instancesByPosition,
		(AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> AvailableQualifiedMovesByLogicalColour
-> AvailableQualifiedMovesByLogicalColour
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AvailableQualifiedMoves -> AvailableQualifiedMoves
sortAvailableQualifiedMoves AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour,
		Maybe GameTerminationReason
maybeTerminationReason
	 ) (LogicalColour, CastleableRooksByLogicalColour, Board,
 TurnsByLogicalColour, Maybe LogicalColour, InstancesByPosition,
 AvailableQualifiedMovesByLogicalColour,
 Maybe GameTerminationReason)
-> (LogicalColour, CastleableRooksByLogicalColour, Board,
    TurnsByLogicalColour, Maybe LogicalColour, InstancesByPosition,
    AvailableQualifiedMovesByLogicalColour,
    Maybe GameTerminationReason)
-> Bool
forall a. Eq a => a -> a -> Bool
== (
		LogicalColour
nextLogicalColour',
		CastleableRooksByLogicalColour
castleableRooksByLogicalColour',
		Board
board',
		TurnsByLogicalColour
turnsByLogicalColour',
		Maybe LogicalColour
maybeChecked',
		InstancesByPosition
instancesByPosition',
		(AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> AvailableQualifiedMovesByLogicalColour
-> AvailableQualifiedMovesByLogicalColour
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AvailableQualifiedMoves -> AvailableQualifiedMoves
sortAvailableQualifiedMoves AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour',
		Maybe GameTerminationReason
maybeTerminationReason'
	 )

instance Control.DeepSeq.NFData Game where
	rnf :: Game -> ()
rnf MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		getBoard :: Game -> Board
getBoard					= Board
board,
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour				= TurnsByLogicalColour
turnsByLogicalColour,
		getMaybeChecked :: Game -> Maybe LogicalColour
getMaybeChecked					= Maybe LogicalColour
maybeChecked,
		getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition				= InstancesByPosition
instancesByPosition,
		getAvailableQualifiedMovesByLogicalColour :: Game -> AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour,
		getMaybeTerminationReason :: Game -> Maybe GameTerminationReason
getMaybeTerminationReason			= Maybe GameTerminationReason
maybeTerminationReason
	} = (LogicalColour, CastleableRooksByLogicalColour, Board,
 TurnsByLogicalColour, Maybe LogicalColour, InstancesByPosition,
 AvailableQualifiedMovesByLogicalColour,
 Maybe GameTerminationReason)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
		LogicalColour
nextLogicalColour,
		CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		Board
board,
		TurnsByLogicalColour
turnsByLogicalColour,
		Maybe LogicalColour
maybeChecked,
		InstancesByPosition
instancesByPosition,
		AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour,
		Maybe GameTerminationReason
maybeTerminationReason
	 ) -- Represent as a tuple.

instance Show Game where
	showsPrec :: Int -> Game -> ShowS
showsPrec Int
precedence MkGame {
		getBoard :: Game -> Board
getBoard			= Board
board,
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour		= TurnsByLogicalColour
turnsByLogicalColour,
		getMaybeTerminationReason :: Game -> Maybe GameTerminationReason
getMaybeTerminationReason	= Maybe GameTerminationReason
maybeTerminationReason
	} = Int
-> (Board, TurnsByLogicalColour, Maybe GameTerminationReason)
-> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence (
		Board
board,
		TurnsByLogicalColour
turnsByLogicalColour,
		Maybe GameTerminationReason
maybeTerminationReason
	 ) -- Represent as a tuple those fields which can't be inferred.

instance Read Game where
	readsPrec :: Int -> ReadS Game
readsPrec Int
precedence	= (((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
  String)
 -> (Game, String))
-> [((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
     String)]
-> [(Game, String)]
forall a b. (a -> b) -> [a] -> [b]
map (
		((Board, TurnsByLogicalColour, Maybe GameTerminationReason)
 -> Game)
-> ((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
    String)
-> (Game, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (((Board, TurnsByLogicalColour, Maybe GameTerminationReason)
  -> Game)
 -> ((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
     String)
 -> (Game, String))
-> ((Board, TurnsByLogicalColour, Maybe GameTerminationReason)
    -> Game)
-> ((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
    String)
-> (Game, String)
forall a b. (a -> b) -> a -> b
$ \(
			Board
board,
			TurnsByLogicalColour
turnsByLogicalColour,
			Maybe GameTerminationReason
maybeTerminationReason
		) {-tuple-} -> let
			game :: Game
game = (
				(LogicalColour
 -> CastleableRooksByLogicalColour
 -> Board
 -> TurnsByLogicalColour
 -> Game)
-> (LogicalColour, CastleableRooksByLogicalColour)
-> Board
-> TurnsByLogicalColour
-> Game
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LogicalColour
-> CastleableRooksByLogicalColour
-> Board
-> TurnsByLogicalColour
-> Game
mkGame (
					TurnsByLogicalColour -> LogicalColour
forall turn. TurnsByLogicalColour turn -> LogicalColour
State.TurnsByLogicalColour.inferNextLogicalColour (TurnsByLogicalColour -> LogicalColour)
-> (TurnsByLogicalColour -> CastleableRooksByLogicalColour)
-> TurnsByLogicalColour
-> (LogicalColour, CastleableRooksByLogicalColour)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TurnsByLogicalColour -> CastleableRooksByLogicalColour
State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour (TurnsByLogicalColour
 -> (LogicalColour, CastleableRooksByLogicalColour))
-> TurnsByLogicalColour
-> (LogicalColour, CastleableRooksByLogicalColour)
forall a b. (a -> b) -> a -> b
$ TurnsByLogicalColour
turnsByLogicalColour
				) Board
board TurnsByLogicalColour
turnsByLogicalColour
			 ) {
				getInstancesByPosition :: InstancesByPosition
getInstancesByPosition		= Game -> InstancesByPosition
mkInstancesByPosition Game
game,
				getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason	= Maybe GameTerminationReason
maybeTerminationReason
			}
		in Game
game
	 ) ([((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
   String)]
 -> [(Game, String)])
-> (String
    -> [((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
         String)])
-> ReadS Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String
-> [((Board, TurnsByLogicalColour, Maybe GameTerminationReason),
     String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence

instance Data.Default.Default Game where
	def :: Game
def = (
		LogicalColour
-> CastleableRooksByLogicalColour
-> Board
-> TurnsByLogicalColour
-> Game
mkGame LogicalColour
Attribute.LogicalColour.White CastleableRooksByLogicalColour
forall a. Default a => a
Data.Default.def {-castleableRooksByLogicalColour-} Board
forall a. Default a => a
Data.Default.def {-board-} TurnsByLogicalColour
forall a. Default a => a
Data.Default.def {-turnsByLogicalColour-}
	 ) {
		getMaybeChecked :: Maybe LogicalColour
getMaybeChecked					= Maybe LogicalColour
forall a. Maybe a
Nothing,
		getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= [(LogicalColour, AvailableQualifiedMoves)]
-> AvailableQualifiedMovesByLogicalColour
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(LogicalColour, AvailableQualifiedMoves)]
 -> AvailableQualifiedMovesByLogicalColour)
-> [(LogicalColour, AvailableQualifiedMoves)]
-> AvailableQualifiedMovesByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, AvailableQualifiedMoves))
-> [LogicalColour] -> [(LogicalColour, AvailableQualifiedMoves)]
forall a b. (a -> b) -> [a] -> [b]
map (
			LogicalColour -> LogicalColour
forall a. a -> a
id (LogicalColour -> LogicalColour)
-> (LogicalColour -> AvailableQualifiedMoves)
-> LogicalColour
-> (LogicalColour, AvailableQualifiedMoves)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (LogicalColour -> Game -> AvailableQualifiedMoves
`mkAvailableQualifiedMovesFor` Game
forall a. Default a => a
Data.Default.def {-game-})
		) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
	}

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

instance Property.ExtendedPositionDescription.ShowsEPD Game where
	showsEPD :: Game -> ShowS
showsEPD game :: Game
game@MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		getBoard :: Game -> Board
getBoard				= Board
board
	 } = ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
Text.ShowList.showsDelimitedList ShowS
Property.ExtendedPositionDescription.showsSeparator ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id [
		Board -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD Board
board,				-- 1. Placement of pieces.
		LogicalColour -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD LogicalColour
nextLogicalColour,		-- 2. Active colour.
		CastleableRooksByLogicalColour -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD CastleableRooksByLogicalColour
castleableRooksByLogicalColour,	-- 3. Castling availability.
		ShowS -> (Turn -> ShowS) -> Maybe Turn -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
Property.ExtendedPositionDescription.showsNullField (
			\Turn
turn -> if LogicalColour -> Turn -> Bool
Component.Turn.isPawnDoubleAdvance (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) Turn
turn
				then MoveNotation -> Coordinates -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
forall a. Default a => a
Data.Default.def {-Smith is the same as the required Algebraic notation in this limited role-} (Coordinates -> ShowS)
-> (QualifiedMove -> Coordinates) -> QualifiedMove -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour (Coordinates -> Coordinates)
-> (QualifiedMove -> Coordinates) -> QualifiedMove -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> Coordinates)
-> (QualifiedMove -> Move) -> QualifiedMove -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> ShowS) -> QualifiedMove -> ShowS
forall a b. (a -> b) -> a -> b
$ Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
				else ShowS
Property.ExtendedPositionDescription.showsNullField
		) (Maybe Turn -> ShowS) -> Maybe Turn -> ShowS
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
maybeLastTurn Game
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 :: ReadS Game
readsFEN String
s	= [
		(Game
game, String
s3) |
			(Game
game, String
s1)		<- ReadS Game
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD String
s,
			(Int
_halfMoveClock, String
s2)	<- ReadS Int
forall a. Read a => ReadS a
reads String
s1 :: [(Int, String)],
			(Int
_fullMoveCounter, String
s3)	<- ReadS Int
forall a. Read a => ReadS a
reads String
s2 :: [(Int, String)]
	 ] -- List-comprehension.

instance Property.ForsythEdwards.ShowsFEN Game where
	showsFEN :: Game -> ShowS
showsFEN game :: Game
game@MkGame {
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour	= TurnsByLogicalColour
turnsByLogicalColour,
		getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition	= InstancesByPosition
instancesByPosition
	 } = ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
Text.ShowList.showsDelimitedList ShowS
Property.ExtendedPositionDescription.showsSeparator ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id [
		Game -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD Game
game,
		Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ InstancesByPosition -> Int
forall position. InstancesByPosition position -> Int
State.InstancesByPosition.countConsecutiveRepeatablePlies InstancesByPosition
instancesByPosition, -- 5. Half move clock.
		Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> ([Turn] -> Int) -> [Turn] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ {-the full-move counter starts at '1', before any move has occurred-} (Int -> Int) -> ([Turn] -> Int) -> [Turn] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Turn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Turn] -> ShowS) -> [Turn] -> ShowS
forall a b. (a -> b) -> a -> b
$ LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
Attribute.LogicalColour.Black TurnsByLogicalColour
turnsByLogicalColour	-- 6. Full move counter.
	 ]

instance Property.Empty.Empty Game where
	empty :: Game
empty	= Game
forall a. Default a => a
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 :: Game -> Bool
isNull MkGame { getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour = TurnsByLogicalColour
turnsByLogicalColour }	= TurnsByLogicalColour -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull TurnsByLogicalColour
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 :: Game -> Game
reflectOnX MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		getBoard :: Game -> Board
getBoard				= Board
board,
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour			= TurnsByLogicalColour
turnsByLogicalColour,
		getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition			= InstancesByPosition
instancesByPosition,
		getMaybeTerminationReason :: Game -> Maybe GameTerminationReason
getMaybeTerminationReason		= Maybe GameTerminationReason
maybeTerminationReason
	} = (
		LogicalColour
-> CastleableRooksByLogicalColour
-> Board
-> TurnsByLogicalColour
-> Game
mkGame (
			LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
		) (
			CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX CastleableRooksByLogicalColour
castleableRooksByLogicalColour
		) (
			Board -> Board
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Board
board
		) (
			TurnsByLogicalColour -> TurnsByLogicalColour
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX TurnsByLogicalColour
turnsByLogicalColour
		)
	 ) {
		getInstancesByPosition :: InstancesByPosition
getInstancesByPosition		= InstancesByPosition -> InstancesByPosition
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX InstancesByPosition
instancesByPosition,
		getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason	= (GameTerminationReason -> GameTerminationReason)
-> Maybe GameTerminationReason -> Maybe GameTerminationReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GameTerminationReason -> GameTerminationReason
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Maybe GameTerminationReason
maybeTerminationReason
	}

instance StateProperty.Hashable.Hashable Game where
	listRandoms :: Game -> Zobrist positionHash -> [positionHash]
listRandoms game :: Game
game@MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
		getBoard :: Game -> Board
getBoard				= Board
board
	} Zobrist positionHash
zobrist	= (
		if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
nextLogicalColour
			then (Zobrist positionHash -> positionHash
forall positionHash. Zobrist positionHash -> positionHash
Component.Zobrist.getRandomForBlacksMove Zobrist positionHash
zobrist positionHash -> [positionHash] -> [positionHash]
forall a. a -> [a] -> [a]
:)
			else [positionHash] -> [positionHash]
forall a. a -> a
id
	 ) ([positionHash] -> [positionHash])
-> ([positionHash] -> [positionHash])
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([positionHash] -> [positionHash])
-> (EnPassantAbscissa -> [positionHash] -> [positionHash])
-> Maybe EnPassantAbscissa
-> [positionHash]
-> [positionHash]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [positionHash] -> [positionHash]
forall a. a -> a
id (
		[positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
(++) ([positionHash] -> [positionHash] -> [positionHash])
-> (EnPassantAbscissa -> [positionHash])
-> EnPassantAbscissa
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnPassantAbscissa -> Zobrist positionHash -> [positionHash]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
`StateProperty.Hashable.listRandoms` Zobrist positionHash
zobrist)
	 ) (
		Game -> Maybe Turn
maybeLastTurn Game
game Maybe Turn
-> (Turn -> Maybe EnPassantAbscissa) -> Maybe EnPassantAbscissa
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour
-> MaybePieceByCoordinates -> Turn -> Maybe EnPassantAbscissa
State.EnPassantAbscissa.mkMaybeEnPassantAbscissa LogicalColour
nextLogicalColour (
			Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board
		)
	 ) ([positionHash] -> [positionHash])
-> [positionHash] -> [positionHash]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour
-> Zobrist positionHash -> [positionHash]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
StateProperty.Hashable.listRandoms CastleableRooksByLogicalColour
castleableRooksByLogicalColour Zobrist positionHash
zobrist [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++ Board -> Zobrist positionHash -> [positionHash]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
StateProperty.Hashable.listRandoms Board
board Zobrist positionHash
zobrist

-- | Smart constructor.
mkGame
	:: Attribute.LogicalColour.LogicalColour	-- ^ The player who is required to move next.
	-> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour
	-> State.Board.Board
	-> State.CastleableRooksByLogicalColour.TurnsByLogicalColour
	-> Game
mkGame :: LogicalColour
-> CastleableRooksByLogicalColour
-> Board
-> TurnsByLogicalColour
-> Game
mkGame LogicalColour
nextLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour Board
board TurnsByLogicalColour
turnsByLogicalColour
	| Bool -> Bool
not (Bool -> Bool)
-> (CoordinatesByRankByLogicalColour -> Bool)
-> CoordinatesByRankByLogicalColour
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRankByLogicalColour -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasBothKings (CoordinatesByRankByLogicalColour -> Bool)
-> CoordinatesByRankByLogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour Board
board	= Exception -> Game
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game) -> (String -> Exception) -> String -> Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.mkGame:\tboth Kings must exist; " (String -> Game) -> String -> Game
forall a b. (a -> b) -> a -> b
$ Board -> ShowS
forall a. Show a => a -> ShowS
shows Board
board String
"."
	| LogicalColour -> Board -> Bool
State.Board.isKingChecked (
		LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
	) Board
board		= Exception -> Game
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game) -> (String -> Exception) -> String -> Game
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.mkGame:\tthe player who last moved, is still checked; " (String -> Game) -> String -> Game
forall a b. (a -> b) -> a -> b
$ Board -> ShowS
forall a. Show a => a -> ShowS
shows Board
board String
"."
	| Bool
otherwise	= Game
game
	where
		game :: Game
game = MkGame :: LogicalColour
-> CastleableRooksByLogicalColour
-> Board
-> TurnsByLogicalColour
-> Maybe LogicalColour
-> InstancesByPosition
-> AvailableQualifiedMovesByLogicalColour
-> Maybe GameTerminationReason
-> Game
MkGame {
			getNextLogicalColour :: LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour,
			getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
			getBoard :: Board
getBoard					= Board
board,
			getTurnsByLogicalColour :: TurnsByLogicalColour
getTurnsByLogicalColour				= TurnsByLogicalColour
turnsByLogicalColour,
			getMaybeChecked :: Maybe LogicalColour
getMaybeChecked					= (LogicalColour -> Bool) -> [LogicalColour] -> Maybe LogicalColour
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (LogicalColour -> Board -> Bool
`State.Board.isKingChecked` Board
board) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
			getInstancesByPosition :: InstancesByPosition
getInstancesByPosition				= Position -> InstancesByPosition
forall position. position -> InstancesByPosition position
State.InstancesByPosition.mkSingleton (Position -> InstancesByPosition)
-> Position -> InstancesByPosition
forall a b. (a -> b) -> a -> b
$ Game -> Position
mkPosition Game
game,
			getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= [(LogicalColour, AvailableQualifiedMoves)]
-> AvailableQualifiedMovesByLogicalColour
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [
				(LogicalColour
logicalColour, LogicalColour -> Game -> AvailableQualifiedMoves
mkAvailableQualifiedMovesFor LogicalColour
logicalColour Game
game) |
					LogicalColour
logicalColour	<- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
					Game -> Maybe LogicalColour
getMaybeChecked Game
game Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour	-- Define the available qualified moves for unchecked players only.
			], -- List-comprehension.
			getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason			= Game -> Maybe GameTerminationReason
inferMaybeTerminationReason Game
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 -> Game
fromBoard Board
board	= LogicalColour
-> CastleableRooksByLogicalColour
-> Board
-> TurnsByLogicalColour
-> Game
mkGame LogicalColour
Attribute.LogicalColour.White (
	Board -> CastleableRooksByLogicalColour
State.CastleableRooksByLogicalColour.fromBoard Board
board
 ) Board
board TurnsByLogicalColour
forall a. Empty a => a
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 :: Game -> [Turn]
listTurns MkGame {
	getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour	= LogicalColour
nextLogicalColour,
	getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour	= TurnsByLogicalColour
turnsByLogicalColour
} = ([Turn] -> [Turn] -> [Turn]) -> ([Turn], [Turn]) -> [Turn]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Turn] -> [Turn] -> [Turn]
forall a. [a] -> [a] -> [a]
ToolShed.Data.List.interleave (([Turn], [Turn]) -> [Turn]) -> ([Turn], [Turn]) -> [Turn]
forall a b. (a -> b) -> a -> b
$ (
	LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) (TurnsByLogicalColour -> [Turn])
-> (TurnsByLogicalColour -> [Turn])
-> TurnsByLogicalColour
-> ([Turn], [Turn])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
nextLogicalColour
 ) TurnsByLogicalColour
turnsByLogicalColour

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

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

{- |
	* 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 :: Attribute.LogicalColour.LogicalColour -> Game -> [Component.QualifiedMove.QualifiedMove]
findAvailableCastlingMoves :: LogicalColour -> Game -> [QualifiedMove]
findAvailableCastlingMoves LogicalColour
logicalColour MkGame {
	getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
	getBoard :: Game -> Board
getBoard				= Board
board,
	getMaybeChecked :: Game -> Maybe LogicalColour
getMaybeChecked				= Maybe LogicalColour
maybeChecked
}
	| Just LogicalColour
checkedLogicalColour	<- Maybe LogicalColour
maybeChecked
	, LogicalColour
checkedLogicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour	= []	-- One can't Castle out of check.
	| Just [Int]
rooksStartingXs	<- LogicalColour -> CastleableRooksByLogicalColour -> Maybe [Int]
State.CastleableRooksByLogicalColour.locateForLogicalColour LogicalColour
logicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour	= [
		Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove Move
castlingKingsMove (MoveType -> QualifiedMove) -> MoveType -> QualifiedMove
forall a b. (a -> b) -> a -> b
$ CastlingMove -> MoveType
Component.CastlingMove.getMoveType CastlingMove
castlingMove |
			Int
x		<- [Int]
rooksStartingXs,
			CastlingMove
castlingMove	<- LogicalColour -> [CastlingMove]
Component.CastlingMove.getCastlingMoves LogicalColour
logicalColour,
			let castlingRooksSource :: Coordinates
castlingRooksSource	= Move -> Coordinates
Component.Move.getSource (Move -> Coordinates) -> Move -> Coordinates
forall a b. (a -> b) -> a -> b
$ CastlingMove -> Move
Component.CastlingMove.getRooksMove CastlingMove
castlingMove,
			Coordinates -> Int
Cartesian.Coordinates.getX Coordinates
castlingRooksSource Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x,
			Coordinates -> Coordinates -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isClear (
				LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour
			) Coordinates
castlingRooksSource (MaybePieceByCoordinates -> Bool)
-> MaybePieceByCoordinates -> Bool
forall a b. (a -> b) -> a -> b
$ Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board,
			let castlingKingsMove :: Move
castlingKingsMove	= CastlingMove -> Move
Component.CastlingMove.getKingsMove CastlingMove
castlingMove,
			(Coordinates -> Bool) -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
				[(Coordinates, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates, Rank)] -> Bool)
-> (Coordinates -> [(Coordinates, Rank)]) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Board -> [(Coordinates, Rank)]) -> Board -> [(Coordinates, Rank)]
forall a b. (a -> b) -> a -> b
$ Board
board) ((Board -> [(Coordinates, Rank)]) -> [(Coordinates, Rank)])
-> (Coordinates -> Board -> [(Coordinates, Rank)])
-> Coordinates
-> [(Coordinates, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour
			) ([Coordinates] -> Bool) -> [Coordinates] -> Bool
forall a b. (a -> b) -> a -> b
$ Move -> [Coordinates]
Component.Move.interpolate Move
castlingKingsMove	-- The King mustn't be checked anywhere alongs its route.
	] {-list-comprehension-}
	| Bool
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 :: Coordinates -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates
destination Piece
piece
	| Coordinates -> Piece -> Bool
Component.Piece.isPawnPromotion Coordinates
destination Piece
piece	= (Rank -> Maybe Rank) -> [Rank] -> [Maybe Rank]
forall a b. (a -> b) -> [a] -> [b]
map Rank -> Maybe Rank
forall a. a -> Maybe a
Just [Rank]
Attribute.Rank.promotionProspects
	| Bool
otherwise						= [Maybe Rank
forall a. Maybe a
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 -> Game
takeTurn Turn
turn game :: Game
game@MkGame {
	getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour,
	getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour
castleableRooksByLogicalColour,
	getBoard :: Game -> Board
getBoard					= Board
board,
	getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour				= TurnsByLogicalColour
turnsByLogicalColour,
	getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition				= InstancesByPosition
instancesByPosition,
	getAvailableQualifiedMovesByLogicalColour :: Game -> AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour
} = Bool -> Game -> Game
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
	Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Game -> Bool
isTerminated Game
game	-- CAVEAT: otherwise any resignation will be overwritten.
 ) Game
game' where
	((Move
move, MoveType
moveType), Rank
sourceRank)	= (QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove -> (Move, MoveType))
-> (Turn -> QualifiedMove) -> Turn -> (Move, MoveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove (Turn -> (Move, MoveType))
-> (Turn -> Rank) -> Turn -> ((Move, MoveType), Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Turn -> Rank
Component.Turn.getRank (Turn -> ((Move, MoveType), Rank))
-> Turn -> ((Move, MoveType), Rank)
forall a b. (a -> b) -> a -> b
$ Turn
turn	-- Deconstruct.
	(Coordinates
source, Coordinates
destination)		= Move -> Coordinates
Component.Move.getSource (Move -> Coordinates)
-> (Move -> Coordinates) -> Move -> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move -> Coordinates
Component.Move.getDestination (Move -> (Coordinates, Coordinates))
-> Move -> (Coordinates, Coordinates)
forall a b. (a -> b) -> a -> b
$ Move
move	-- Deconstruct.

	opponentsLogicalColour :: Attribute.LogicalColour.LogicalColour
	opponentsLogicalColour :: LogicalColour
opponentsLogicalColour	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour

	inferredRooksMove :: Move
inferredRooksMove	= Move -> (CastlingMove -> Move) -> Maybe CastlingMove -> Move
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
		Exception -> Move
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Move) -> (String -> Exception) -> String -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.takeTurn:\tfailed to find any Rook's move corresponding to " (String -> Move) -> String -> Move
forall a b. (a -> b) -> a -> b
$ (Move, MoveType) -> ShowS
forall a. Show a => a -> ShowS
shows (Move
move, MoveType
moveType) String
"."
	 ) CastlingMove -> Move
Component.CastlingMove.getRooksMove (Maybe CastlingMove -> Move)
-> ([CastlingMove] -> Maybe CastlingMove) -> [CastlingMove] -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CastlingMove -> Bool) -> [CastlingMove] -> Maybe CastlingMove
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
		(Move -> Move -> Bool
forall a. Eq a => a -> a -> Bool
== Move
move) (Move -> Bool) -> (CastlingMove -> Move) -> CastlingMove -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove -> Move
Component.CastlingMove.getKingsMove
	 ) ([CastlingMove] -> Move) -> [CastlingMove] -> Move
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [CastlingMove]
Component.CastlingMove.getCastlingMoves LogicalColour
nextLogicalColour

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

	maybePieceByCoordinates' :: MaybePieceByCoordinates
maybePieceByCoordinates'	= Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board'	-- Deconstruct.

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

			kingsByCoordinates :: [(Coordinates, Piece)]
kingsByCoordinates	= (LogicalColour -> (Coordinates, Piece))
-> [LogicalColour] -> [(Coordinates, Piece)]
forall a b. (a -> b) -> [a] -> [b]
map (
				(LogicalColour -> CoordinatesByRankByLogicalColour -> Coordinates
`State.CoordinatesByRankByLogicalColour.getKingsCoordinates` Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour Board
board') (LogicalColour -> Coordinates)
-> (LogicalColour -> Piece)
-> LogicalColour
-> (Coordinates, Piece)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Piece
Component.Piece.mkKing
			 ) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

			([(Coordinates, Piece)]
affected, [(Coordinates, Piece)]
affected')	= (
				[(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. Eq a => [a] -> [a]
Data.List.nub ([(Coordinates, Piece)] -> [(Coordinates, Piece)])
-> ([(Coordinates, Piece)] -> [(Coordinates, Piece)])
-> [(Coordinates, Piece)]
-> [(Coordinates, Piece)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (
					Coordinates
destination,
					LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
nextLogicalColour (Rank -> Piece) -> (Maybe Rank -> Rank) -> Maybe Rank -> Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> Maybe Rank -> Rank
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Rank
sourceRank (Maybe Rank -> Piece) -> Maybe Rank -> Piece
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank MoveType
moveType
				) ([(Coordinates, Piece)] -> [(Coordinates, Piece)])
-> ([(Coordinates, Piece)] -> [(Coordinates, Piece)])
-> ([(Coordinates, Piece)], [(Coordinates, Piece)])
-> ([(Coordinates, Piece)], [(Coordinates, Piece)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. Eq a => [a] -> [a]
Data.List.nub
			 ) (([(Coordinates, Piece)], [(Coordinates, Piece)])
 -> ([(Coordinates, Piece)], [(Coordinates, Piece)]))
-> ([(Coordinates, Piece)]
    -> ([(Coordinates, Piece)], [(Coordinates, Piece)]))
-> [(Coordinates, Piece)]
-> ([(Coordinates, Piece)], [(Coordinates, Piece)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates, Piece) -> Bool)
-> [(Coordinates, Piece)]
-> ([(Coordinates, Piece)], [(Coordinates, Piece)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition (
				(LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
nextLogicalColour) (LogicalColour -> Bool)
-> ((Coordinates, Piece) -> LogicalColour)
-> (Coordinates, Piece)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour (Piece -> LogicalColour)
-> ((Coordinates, Piece) -> Piece)
-> (Coordinates, Piece)
-> LogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates, Piece) -> Piece
forall a b. (a, b) -> b
snd {-piece-}
			 ) ([(Coordinates, Piece)]
 -> ([(Coordinates, Piece)], [(Coordinates, Piece)]))
-> ([(Coordinates, Piece)] -> [(Coordinates, Piece)])
-> [(Coordinates, Piece)]
-> ([(Coordinates, Piece)], [(Coordinates, Piece)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
				if LogicalColour -> Turn -> Bool
Component.Turn.isPawnDoubleAdvance LogicalColour
nextLogicalColour Turn
turn
					then [(Coordinates, Piece)]
-> [(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. [a] -> [a] -> [a]
(++) [
						(Coordinates
pawnCoordinates, Piece
oppositePiece) |
							let oppositePiece :: Piece
oppositePiece	= LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
opponentsLogicalColour Rank
sourceRank,
							Coordinates
pawnCoordinates	<- Coordinates -> [Coordinates]
Cartesian.Coordinates.getAdjacents Coordinates
destination,
							Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
pawnCoordinates (Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board) Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
oppositePiece	-- Find any opposing Pawn which can capture En-passant.
					] {-list-comprehension-}
					else [(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. a -> a
id
			 ) ([(Coordinates, Piece)]
 -> ([(Coordinates, Piece)], [(Coordinates, Piece)]))
-> [(Coordinates, Piece)]
-> ([(Coordinates, Piece)], [(Coordinates, Piece)])
forall a b. (a -> b) -> a -> b
$ [(Coordinates, Piece)]
kingsByCoordinates {-moves available to either King may be constrained or liberated, even if misaligned with move-endpoints-} [(Coordinates, Piece)]
-> [(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. [a] -> [a] -> [a]
++ [
				(Coordinates
knightsCoordinates, LogicalColour -> Piece
Component.Piece.mkKnight LogicalColour
knightsColour) |
					LogicalColour
knightsColour		<- [LogicalColour]
forall a. FixedMembership a => [a]
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.
					Coordinates
moveEndpoint		<- [Coordinates]
moveEndpoints,
					Coordinates
knightsCoordinates	<- LogicalColour -> Coordinates -> Board -> [Coordinates]
forall seeker.
Seeker seeker =>
LogicalColour -> Coordinates -> seeker -> [Coordinates]
StateProperty.Seeker.findProximateKnights LogicalColour
knightsColour Coordinates
moveEndpoint Board
board'
			 ] {-list-comprehension-} [(Coordinates, Piece)]
-> [(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. [a] -> [a] -> [a]
++ (
				if Rank
sourceRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.King
					then [
						(Coordinates
blockingCoordinates, Piece
blockingPiece) |
							(Coordinates
kingsCoordinates, Piece
_)			<- [(Coordinates, Piece)]
kingsByCoordinates,
							Direction
direction				<- [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
							(Coordinates
blockingCoordinates, Piece
blockingPiece)	<- Maybe (Coordinates, Piece) -> [(Coordinates, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates, Piece) -> [(Coordinates, Piece)])
-> Maybe (Coordinates, Piece) -> [(Coordinates, Piece)]
forall a b. (a -> b) -> a -> b
$ Direction
-> Coordinates
-> MaybePieceByCoordinates
-> Maybe (Coordinates, Piece)
State.MaybePieceByCoordinates.findBlockingPiece Direction
direction Coordinates
kingsCoordinates MaybePieceByCoordinates
maybePieceByCoordinates'
					] -- List-comprehension. Re-evaluate the moves available to all pieces aligned with a King.
					else [
						(Coordinates
blockingCoordinates, Piece
blockingPiece) |
							(Coordinates
kingsCoordinates, Piece
_)			<- [(Coordinates, Piece)]
kingsByCoordinates,
							Coordinates
moveEndpoint				<- [Coordinates]
moveEndpoints,
							Direction
direction				<- Maybe Direction -> [Direction]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe Direction -> [Direction])
-> (Vector -> Maybe Direction) -> Vector -> [Direction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector -> Maybe Direction
Cartesian.Vector.toMaybeDirection (Vector -> [Direction]) -> Vector -> [Direction]
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
kingsCoordinates Coordinates
moveEndpoint, -- N.B. null when the King isn't aligned with any move-endpoint.
							let findBlockingPieceFrom :: Coordinates -> Maybe (Coordinates, Piece)
findBlockingPieceFrom Coordinates
coordinates	= Direction
-> Coordinates
-> MaybePieceByCoordinates
-> Maybe (Coordinates, Piece)
State.MaybePieceByCoordinates.findBlockingPiece Direction
direction Coordinates
coordinates MaybePieceByCoordinates
maybePieceByCoordinates',
							(Coordinates
blockingCoordinates, Piece
blockingPiece)	<- Maybe (Coordinates, Piece) -> [(Coordinates, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates, Piece) -> [(Coordinates, Piece)])
-> Maybe (Coordinates, Piece) -> [(Coordinates, Piece)]
forall a b. (a -> b) -> a -> b
$ (
								\pair :: (Coordinates, Piece)
pair@(Coordinates
coordinates, Piece
_) -> if Coordinates
coordinates Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates
destination
									then (Coordinates, Piece) -> Maybe (Coordinates, Piece)
forall a. a -> Maybe a
Just (Coordinates, Piece)
pair
									else {-blocker is destination-} if Vector -> Maybe Direction
Cartesian.Vector.toMaybeDirection (Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
kingsCoordinates Coordinates
source) Maybe Direction -> Maybe Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
direction
										then Maybe (Coordinates, Piece)
forall a. Maybe a
Nothing
										else Coordinates -> Maybe (Coordinates, Piece)
findBlockingPieceFrom Coordinates
coordinates	-- Look through the destination to the previous blocker; which might be the source.
							) ((Coordinates, Piece) -> Maybe (Coordinates, Piece))
-> Maybe (Coordinates, Piece) -> Maybe (Coordinates, Piece)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Coordinates -> Maybe (Coordinates, Piece)
findBlockingPieceFrom Coordinates
kingsCoordinates
					] -- List-comprehension. Re-evaluate the moves available to all pieces aligned with a King & a move-endpoint.
			 ) [(Coordinates, Piece)]
-> [(Coordinates, Piece)] -> [(Coordinates, Piece)]
forall a. [a] -> [a] -> [a]
++ [
				(Coordinates
coordinates, Piece
affectedPiece) |
					Coordinates
moveEndpoint			<- [Coordinates]
moveEndpoints,
					Direction
direction			<- [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
					(Coordinates
coordinates, Piece
affectedPiece)	<- Maybe (Coordinates, Piece) -> [(Coordinates, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates, Piece) -> [(Coordinates, Piece)])
-> Maybe (Coordinates, Piece) -> [(Coordinates, Piece)]
forall a b. (a -> b) -> a -> b
$ Direction
-> Coordinates
-> MaybePieceByCoordinates
-> Maybe (Coordinates, Piece)
State.MaybePieceByCoordinates.findBlockingPiece Direction
direction Coordinates
moveEndpoint MaybePieceByCoordinates
maybePieceByCoordinates',
					Coordinates
coordinates Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates
destination,	-- Added above.
					Bool -> Bool
not (Bool -> Bool) -> ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ (Piece -> Bool
Component.Piece.isKnight (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Piece -> Bool
Component.Piece.isKing) Piece
affectedPiece,	-- Added above.
					Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canMoveBetween Coordinates
coordinates Coordinates
moveEndpoint Piece
affectedPiece
			 ] -- 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
-> [(Coordinates, Piece)] -> AvailableQualifiedMoves
insertMovesFrom	= ((Coordinates, Piece)
 -> AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> AvailableQualifiedMoves
-> [(Coordinates, Piece)]
-> AvailableQualifiedMoves
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Coordinates, Piece)
  -> AvailableQualifiedMoves -> AvailableQualifiedMoves)
 -> AvailableQualifiedMoves
 -> [(Coordinates, Piece)]
 -> AvailableQualifiedMoves)
-> ((Coordinates, Piece)
    -> AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> AvailableQualifiedMoves
-> [(Coordinates, Piece)]
-> AvailableQualifiedMoves
forall a b. (a -> b) -> a -> b
$ \(Coordinates
source', Piece
piece') -> let
				logicalColour :: LogicalColour
logicalColour			= Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece'
				isSafeDestination :: Coordinates -> Bool
isSafeDestination Coordinates
destination'	= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Move -> Board -> Bool
State.Board.exposesKing LogicalColour
logicalColour (Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source' Coordinates
destination') Board
board'
			 in case [
				(Coordinates
destination', MoveType
Attribute.MoveType.EnPassant) |
					LogicalColour -> Coordinates -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
logicalColour Coordinates
source',
					Piece -> Bool
Component.Piece.isPawn Piece
piece',
					Coordinates
destination'	<- Coordinates -> Piece -> [Coordinates]
Component.Piece.findAttackDestinations Coordinates
source' Piece
piece',
					Coordinates -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isVacant Coordinates
destination' MaybePieceByCoordinates
maybePieceByCoordinates',
					(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (Coordinates -> (Bool, Bool)) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
						(Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Piece
piece')) (Maybe Piece -> Bool)
-> (Coordinates -> Maybe Piece) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
							Coordinates -> MaybePieceByCoordinates -> Maybe Piece
`State.MaybePieceByCoordinates.dereference` MaybePieceByCoordinates
maybePieceByCoordinates'
						) (Coordinates -> Bool)
-> (Coordinates -> Bool) -> Coordinates -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Move -> Move -> Bool
forall a. Eq a => a -> a -> Bool
== Move
move) (Move -> Bool) -> (Coordinates -> Move) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Coordinates -> Move
Component.Move.mkMove (LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates
destination')
					) (Coordinates -> Bool) -> Coordinates -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates
destination',	-- Did an opposing Pawn just double-advance to the expected position ?
					Coordinates -> Bool
isSafeDestination Coordinates
destination'
			 ] {-list-comprehension-} [(Coordinates, MoveType)]
-> [(Coordinates, MoveType)] -> [(Coordinates, MoveType)]
forall a. [a] -> [a] -> [a]
++ [
				(
					Coordinates
destination',
					Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank
				) |
					(Coordinates
destination', Maybe Rank
maybeTakenRank)	<- Coordinates
-> Piece -> MaybePieceByCoordinates -> [(Coordinates, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates
source' Piece
piece' MaybePieceByCoordinates
maybePieceByCoordinates',
					Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King,	-- This move can never be made; the option will either be immediately removed or check-mate declared.
					Coordinates -> Bool
isSafeDestination Coordinates
destination',
					Maybe Rank
maybePromotionRank		<- Coordinates -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates
destination' Piece
piece'
			 ] {-list-comprehension-} of
				[]			-> Coordinates -> AvailableQualifiedMoves -> AvailableQualifiedMoves
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coordinates
source'				-- There're zero moves from here.
				[(Coordinates, MoveType)]
qualifiedDestinations	-> Coordinates
-> [(Coordinates, MoveType)]
-> AvailableQualifiedMoves
-> AvailableQualifiedMoves
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Coordinates
source' [(Coordinates, MoveType)]
qualifiedDestinations	-- Overwrite any existing moves.

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

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

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

						) [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ [
							(
								Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
sourceLogicalColour,
								String
"it can't castle out of check"
							), (
								Bool -> Bool
not (Bool -> Bool) -> ([Coordinates] -> Bool) -> [Coordinates] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates -> Bool) -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
									[(Coordinates, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates, Rank)] -> Bool)
-> (Coordinates -> [(Coordinates, Rank)]) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Board -> [(Coordinates, Rank)]) -> Board -> [(Coordinates, Rank)]
forall a b. (a -> b) -> a -> b
$ Board
board) ((Board -> [(Coordinates, Rank)]) -> [(Coordinates, Rank)])
-> (Coordinates -> Board -> [(Coordinates, Rank)])
-> Coordinates
-> [(Coordinates, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
State.Board.findAttackersOf LogicalColour
sourceLogicalColour
								) ([Coordinates] -> Bool) -> [Coordinates] -> Bool
forall a b. (a -> b) -> a -> b
$ Move -> [Coordinates]
Component.Move.interpolate Move
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.
								String
"it can't castle through check"
							)
						] -- Tests which are independent of the implied Rook.
			) {-rank-specific test-} [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ [
				ShowS -> (Bool, String) -> (Bool, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (
					if Piece -> Bool
Component.Piece.isKing Piece
sourcePiece
						then String -> ShowS
showString String
"it"
						else String -> ShowS
showString String
"your '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. Show a => a -> ShowS
shows (LogicalColour -> Piece
Component.Piece.mkKing LogicalColour
sourceLogicalColour) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\''
				) ((Bool, String) -> (Bool, String))
-> (Bool, String) -> (Bool, String)
forall a b. (a -> b) -> a -> b
$ if Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
sourceLogicalColour
					then (
						LogicalColour -> Board -> Bool
State.Board.isKingChecked LogicalColour
sourceLogicalColour (Board -> Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ Move -> Maybe MoveType -> Board -> Board
State.Board.movePiece Move
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board
board,	-- CAVEAT: don't perform an unvalidated move at the Game-level.
						String
" remains checked"
					) -- Pair.
					else (
						LogicalColour -> Move -> Board -> Bool
State.Board.exposesKing LogicalColour
sourceLogicalColour Move
move Board
board,
						String
" would become exposed"
					) -- Pair.
			] -- Post-move tests on one's King.
		)
	) (Maybe Piece -> Maybe String) -> Maybe Piece -> Maybe String
forall a b. (a -> b) -> a -> b
$ Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
source MaybePieceByCoordinates
maybePieceByCoordinates
 ) (
	String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (GameTerminationReason -> String)
-> GameTerminationReason
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTerminationReason -> String
forall a. Show a => a -> String
show	-- The game has been terminated, so there aren't any valid moves.
 ) Maybe GameTerminationReason
maybeTerminationReason where
	(Move
move, MoveType
moveType)	= QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> (Move, MoveType))
-> QualifiedMove -> (Move, MoveType)
forall a b. (a -> b) -> a -> b
$ QualifiedMove
qualifiedMove
	(Coordinates
source, Coordinates
destination)	= Move -> Coordinates
Component.Move.getSource (Move -> Coordinates)
-> (Move -> Coordinates) -> Move -> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move -> Coordinates
Component.Move.getDestination (Move -> (Coordinates, Coordinates))
-> Move -> (Coordinates, Coordinates)
forall a b. (a -> b) -> a -> b
$ Move
move	-- Deconstruct.
	maybePieceByCoordinates :: MaybePieceByCoordinates
maybePieceByCoordinates	= Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board
	maybeDestinationPiece :: Maybe Piece
maybeDestinationPiece	= Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
destination MaybePieceByCoordinates
maybePieceByCoordinates	-- Query.
	distance :: Vector
distance		= Move -> Vector
Component.Move.measureDistance Move
move

	isObstructed :: Bool
	isObstructed :: Bool
isObstructed	= Coordinates -> Coordinates -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isObstructed Coordinates
source Coordinates
destination MaybePieceByCoordinates
maybePieceByCoordinates

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

		maybePieceByCoordinates :: MaybePieceByCoordinates
maybePieceByCoordinates		= Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board

		inferredMoveType :: Attribute.MoveType.MoveType
		inferredMoveType :: MoveType
inferredMoveType	= Move -> Maybe Rank -> MaybePieceByCoordinates -> MoveType
State.MaybePieceByCoordinates.inferMoveType Move
move (
			Maybe Rank -> Maybe Rank
forall a. a -> a
id (Maybe Rank -> Maybe Rank)
-> (MoveType -> Maybe Rank)
-> Either (Maybe Rank) MoveType
-> Maybe Rank
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank (Either (Maybe Rank) MoveType -> Maybe Rank)
-> Either (Maybe Rank) MoveType -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ Either (Maybe Rank) MoveType
promotionRankOrMoveType	-- Discard any move-type.
		 ) MaybePieceByCoordinates
maybePieceByCoordinates

-- | Whether the specified /QualifiedMove/ is valid.
isValidQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Game -> Bool
isValidQualifiedMove :: QualifiedMove -> Game -> Bool
isValidQualifiedMove QualifiedMove
qualifiedMove	= Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool) -> (Game -> Maybe String) -> Game -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Game -> Maybe String
validateQualifiedMove QualifiedMove
qualifiedMove

-- | Whether the specified /EitherQualifiedMove/ is valid.
isValidEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove -> Game -> Bool
isValidEitherQualifiedMove :: EitherQualifiedMove -> Game -> Bool
isValidEitherQualifiedMove EitherQualifiedMove
eitherQualifiedMove	= Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool) -> (Game -> Maybe String) -> Game -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherQualifiedMove -> Game -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove
eitherQualifiedMove

{- |
	* 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 :: Game -> [(Game, Turn)]
rollBack	= (Game -> Maybe ((Game, Turn), Game)) -> Game -> [(Game, Turn)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
Data.List.unfoldr (
	\game :: Game
game@MkGame {
		getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour	= LogicalColour
nextLogicalColour,
		getBoard :: Game -> Board
getBoard		= Board
board,
		getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour	= TurnsByLogicalColour
turnsByLogicalColour,
		getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition	= InstancesByPosition
instancesByPosition
	} -> let
		previousColour :: LogicalColour
previousColour	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
	 in case LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
previousColour TurnsByLogicalColour
turnsByLogicalColour of
		Turn
turn : [Turn]
previousTurns	-> let
			(Move
move, MoveType
moveType)	= (QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove -> (Move, MoveType))
-> QualifiedMove -> (Move, MoveType)
forall a b. (a -> b) -> a -> b
$ Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn	-- Deconstruct.
			destination :: Coordinates
destination		= Move -> Coordinates
Component.Move.getDestination Move
move	-- Deconstruct.

			game' :: Game
game'@MkGame {
				getBoard :: Game -> Board
getBoard		= Board
board',
				getTurnsByLogicalColour :: Game -> TurnsByLogicalColour
getTurnsByLogicalColour	= TurnsByLogicalColour
turnsByLogicalColour',
				getMaybeChecked :: Game -> Maybe LogicalColour
getMaybeChecked		= Maybe LogicalColour
maybeChecked'
			} = Game
game {
				getNextLogicalColour :: LogicalColour
getNextLogicalColour			= LogicalColour
previousColour,
				getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour	= TurnsByLogicalColour -> CastleableRooksByLogicalColour
State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour TurnsByLogicalColour
turnsByLogicalColour',
				getMaybeChecked :: Maybe LogicalColour
getMaybeChecked				= (LogicalColour -> Bool) -> [LogicalColour] -> Maybe LogicalColour
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (LogicalColour -> Board -> Bool
`State.Board.isKingChecked` Board
board') [LogicalColour
previousColour],
				getBoard :: Board
getBoard				= (
					case MoveType
moveType of
						Attribute.MoveType.Castle Bool
isShort	-> Move -> Maybe MoveType -> Board -> Board
State.Board.movePiece (
							(Coordinates -> Coordinates -> Move)
-> (Coordinates, Coordinates) -> Move
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Coordinates -> Move
Component.Move.mkMove ((Coordinates, Coordinates) -> Move)
-> (Coordinates, Coordinates) -> Move
forall a b. (a -> b) -> a -> b
$ (
								(Int -> Int) -> Coordinates -> Coordinates
Cartesian.Coordinates.translateX (
									if Bool
isShort then Int -> Int
forall a. Enum a => a -> a
pred else Int -> Int
forall a. Enum a => a -> a
succ
								) {-rook's source relative to the King-} (Coordinates -> Coordinates)
-> (Coordinates -> Coordinates)
-> Coordinates
-> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Int -> Int) -> Coordinates -> Coordinates
Cartesian.Coordinates.translateX (
									Int -> Int -> Int
forall a b. a -> b -> a
const (Int -> Int -> Int) -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ if Bool
isShort then Int
Cartesian.Abscissa.xMax else Int
Cartesian.Abscissa.xMin
								) {-rook's destination-}
							) Coordinates
destination
						 ) (Maybe MoveType -> Board -> Board)
-> Maybe MoveType -> Board -> Board
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
forall a. Default a => a
Data.Default.def {-move-type-}	-- CAVEAT: this is only the Rook's part of the Castling.
						MoveType
Attribute.MoveType.EnPassant		-> Piece -> Coordinates -> Board -> Board
forall mutator.
Mutator mutator =>
Piece -> Coordinates -> mutator -> mutator
StateProperty.Mutator.placePiece (
							LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
nextLogicalColour
						 ) (Coordinates -> Board -> Board) -> Coordinates -> Board -> Board
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour Coordinates
destination	-- Re-instate the opponent's passing Pawn.
						MoveType
_ {-normal-}
							| MoveType -> Bool
Attribute.MoveType.isPromotion MoveType
moveType	-> Piece -> Coordinates -> Board -> Board
forall mutator.
Mutator mutator =>
Piece -> Coordinates -> mutator -> mutator
StateProperty.Mutator.placePiece (
								LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
previousColour	-- Demote the piece just returned to the source of the move.
							) (Coordinates -> Board -> Board) -> Coordinates -> Board -> Board
forall a b. (a -> b) -> a -> b
$ Move -> Coordinates
Component.Move.getSource Move
move
							| Bool
otherwise					-> Board -> Board
forall a. a -> a
id
				 ) (Board -> Board) -> (Board -> Board) -> Board -> Board
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Board -> Board)
-> (Rank -> Board -> Board) -> Maybe Rank -> Board -> Board
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Board -> Board
forall a. a -> a
id (
					(Piece -> Coordinates -> Board -> Board
forall mutator.
Mutator mutator =>
Piece -> Coordinates -> mutator -> mutator
`StateProperty.Mutator.placePiece` Coordinates
destination) (Piece -> Board -> Board)
-> (Rank -> Piece) -> Rank -> Board -> Board
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
nextLogicalColour
				 ) (
					MoveType -> Maybe Rank
Attribute.MoveType.getMaybeExplicitlyTakenRank MoveType
moveType	-- Reconstruct any piece taken (except en-passant), inferring the logical colour.
				 ) (Board -> Board) -> Board -> Board
forall a b. (a -> b) -> a -> b
$ Move -> Maybe MoveType -> Board -> Board
State.Board.movePiece (Move -> Move
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Move
move) Maybe MoveType
forall a. Maybe a
Nothing {-MoveType-} Board
board,	-- N.B.: operate directly on the board to avoid creating a new Turn in the Game-structure.
				getTurnsByLogicalColour :: TurnsByLogicalColour
getTurnsByLogicalColour	= TurnsByLogicalColour
-> [(LogicalColour, [Turn])] -> TurnsByLogicalColour
forall turn.
TurnsByLogicalColour turn
-> [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
State.TurnsByLogicalColour.update TurnsByLogicalColour
turnsByLogicalColour [(LogicalColour
previousColour, [Turn]
previousTurns)],
				getInstancesByPosition :: InstancesByPosition
getInstancesByPosition	= if Turn -> Bool
Component.Turn.getIsRepeatableMove Turn
turn
					then Position -> InstancesByPosition -> InstancesByPosition
forall position.
Ord position =>
position -> Transformation position
State.InstancesByPosition.deletePosition (Game -> Position
mkPosition Game
game) InstancesByPosition
instancesByPosition
					else Game -> InstancesByPosition
mkInstancesByPosition Game
game',	-- Reconstruct the map prior to the unrepeatable move.
				getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour	= [(LogicalColour, AvailableQualifiedMoves)]
-> AvailableQualifiedMovesByLogicalColour
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList [
					(LogicalColour
logicalColour, LogicalColour -> Game -> AvailableQualifiedMoves
mkAvailableQualifiedMovesFor LogicalColour
logicalColour Game
game') |
						LogicalColour
logicalColour	<- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
						Maybe LogicalColour
maybeChecked' Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour
				], -- List-comprehension.
				getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason	= Maybe GameTerminationReason
forall a. Maybe a
Nothing
			}
		 in ((Game, Turn), Game) -> Maybe ((Game, Turn), Game)
forall a. a -> Maybe a
Just ((Game
game', Turn
turn), Game
game')
		[Turn]
_	-> Maybe ((Game, Turn), Game)
forall a. Maybe a
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
	:: Attribute.LogicalColour.LogicalColour	-- ^ Define the player for whom the moves are required.
	-> Game
	-> [Component.QualifiedMove.QualifiedMove]
listQualifiedMovesAvailableTo :: LogicalColour -> Game -> [QualifiedMove]
listQualifiedMovesAvailableTo LogicalColour
logicalColour game :: Game
game@MkGame {
	getBoard :: Game -> Board
getBoard	= Board
board,
	getMaybeChecked :: Game -> Maybe LogicalColour
getMaybeChecked	= Maybe LogicalColour
maybeChecked
}
	| Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour = let
		kingsCoordinates :: Coordinates
kingsCoordinates	= LogicalColour -> CoordinatesByRankByLogicalColour -> Coordinates
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
	in [
		Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove Move
move MoveType
moveType |
			(Coordinates
destination, Maybe Rank
maybeTakenRank)	<- Coordinates
-> Piece -> MaybePieceByCoordinates -> [(Coordinates, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates
kingsCoordinates (LogicalColour -> Piece
Component.Piece.mkKing LogicalColour
logicalColour) MaybePieceByCoordinates
maybePieceByCoordinates,
			let
				move :: Move
move		= Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
kingsCoordinates Coordinates
destination
				moveType :: MoveType
moveType	= Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
forall a. Maybe a
Nothing {-promotion-rank-},
			[(Coordinates, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates, Rank)] -> Bool)
-> (Board -> [(Coordinates, Rank)]) -> Board -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour Coordinates
destination (Board -> Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ Move -> Maybe MoveType -> Board -> Board
State.Board.movePiece Move
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board
board -- 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-} [QualifiedMove] -> [QualifiedMove] -> [QualifiedMove]
forall a. [a] -> [a] -> [a]
++ case LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour Coordinates
kingsCoordinates Board
board of
		[(Coordinates
checkedFrom, Rank
checkedByRank)]	-> Bool -> [QualifiedMove] -> [QualifiedMove]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Rank
checkedByRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.King) ([QualifiedMove] -> [QualifiedMove])
-> ([QualifiedMove] -> [QualifiedMove])
-> [QualifiedMove]
-> [QualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove -> Bool) -> [QualifiedMove] -> [QualifiedMove]
forall a. (a -> Bool) -> [a] -> [a]
filter QualifiedMove -> Bool
isSafeQualifiedMove ([QualifiedMove] -> [QualifiedMove])
-> [QualifiedMove] -> [QualifiedMove]
forall a b. (a -> b) -> a -> b
$ (
			if Rank
checkedByRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.Pawn
				then [QualifiedMove]
-> (Turn -> [QualifiedMove]) -> Maybe Turn -> [QualifiedMove]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] {-CAVEAT: this can occur if the game has just been read from FEN-} (
					(
						\Move
lastMove -> let
							lastDestination :: Coordinates
lastDestination	= Move -> Coordinates
Component.Move.getDestination Move
lastMove
							pawn :: Piece
pawn		= LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour
						in [
							Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (
								Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source (Coordinates -> Move) -> Coordinates -> Move
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates
lastDestination	-- Construct a move which takes the attacker.
							) MoveType
Attribute.MoveType.enPassant |
								LogicalColour -> Move -> Bool
Component.Move.isPawnDoubleAdvance LogicalColour
opponentsLogicalColour Move
lastMove,
								Coordinates
source	<- Coordinates -> [Coordinates]
Cartesian.Coordinates.getAdjacents Coordinates
lastDestination,
								Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
source MaybePieceByCoordinates
maybePieceByCoordinates Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
pawn
						] -- List-comprehension.
					) (Move -> [QualifiedMove])
-> (Turn -> Move) -> Turn -> [QualifiedMove]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove
				) (Maybe Turn -> [QualifiedMove]) -> Maybe Turn -> [QualifiedMove]
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
maybeLastTurn Game
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.
		 ) [QualifiedMove] -> [QualifiedMove] -> [QualifiedMove]
forall a. [a] -> [a] -> [a]
++ [
			Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (
				Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
checkedFrom	-- Construct a move which takes the attacker.
			) (MoveType -> QualifiedMove) -> MoveType -> QualifiedMove
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType (Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
checkedByRank) Maybe Rank
maybePromotionRank |
				(Coordinates
source, Rank
attackersRank)	<- LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
State.Board.findAttackersOf LogicalColour
opponentsLogicalColour Coordinates
checkedFrom Board
board,	-- See if the attacker can be taken (excluding en-passant).
				Rank
attackersRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.King,	-- The King can take its attacker, but it's already addressed above.
				Maybe Rank
maybePromotionRank	<- Coordinates -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates
checkedFrom {-destination-} (Piece -> [Maybe Rank]) -> Piece -> [Maybe Rank]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
attackersRank
		 ] {-list-comprehension-} [QualifiedMove] -> [QualifiedMove] -> [QualifiedMove]
forall a. [a] -> [a] -> [a]
++ [
			Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (
				Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination
			) (MoveType -> QualifiedMove) -> MoveType -> QualifiedMove
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
forall a. Maybe a
Nothing {-taken rank-} Maybe Rank
maybePromotionRank |
				Rank
checkedByRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.Knight,	-- A Knight can't be blocked.
				Rank
rank			<- [Rank]
Attribute.Rank.expendable,	-- Find pieces that might be able to block the checking piece.
				let piece :: Piece
piece	= LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank,
				Coordinates
source			<- LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
rank CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,	-- Find the source of a potential blocking move.
				(Coordinates
destination, Maybe Rank
Nothing)	<- Coordinates
-> Piece -> MaybePieceByCoordinates -> [(Coordinates, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates
source Piece
piece MaybePieceByCoordinates
maybePieceByCoordinates,	-- The blocker must move to an empty square, otherwise the checker was already blocked.
				Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates
checkedFrom Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates
kingsCoordinates) (Bool -> Bool) -> ([Coordinates] -> Bool) -> [Coordinates] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> [Coordinates] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Coordinates
destination ([Coordinates] -> Bool)
-> ([Coordinates] -> [Coordinates]) -> [Coordinates] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> [Coordinates]
forall a. [a] -> [a]
init {-drop King's location-} ([Coordinates] -> Bool) -> [Coordinates] -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> [Coordinates]
Cartesian.Coordinates.interpolate Coordinates
checkedFrom Coordinates
kingsCoordinates,
				Maybe Rank
maybePromotionRank	<- Coordinates -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates
destination Piece
piece
		 ] -- List-comprehension.
		[(Coordinates, Rank)]
attackers		-> Bool -> [QualifiedMove] -> [QualifiedMove]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
			[(Coordinates, Rank)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Coordinates, Rank)]
attackers Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2	-- Triple-check isn't possible.
		 ) []	-- If checked by more than one piece, then the King must be moved; see options above.
	| Bool
otherwise {-not checked-}	= LogicalColour -> Game -> [QualifiedMove]
findAvailableCastlingMoves LogicalColour
logicalColour Game
game [QualifiedMove] -> [QualifiedMove] -> [QualifiedMove]
forall a. [a] -> [a] -> [a]
++ (QualifiedMove -> Bool) -> [QualifiedMove] -> [QualifiedMove]
forall a. (a -> Bool) -> [a] -> [a]
filter QualifiedMove -> Bool
isSafeQualifiedMove (
		[
			Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (
				Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination
			) MoveType
Attribute.MoveType.enPassant |
				let pawn :: Piece
pawn	= LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour,
				Coordinates
source		<- LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Pawn CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
				LogicalColour -> Coordinates -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
logicalColour Coordinates
source,
				Coordinates
destination	<- Coordinates -> Piece -> [Coordinates]
Component.Piece.findAttackDestinations Coordinates
source Piece
pawn,
				Coordinates -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isVacant Coordinates
destination MaybePieceByCoordinates
maybePieceByCoordinates,
				let opponentsCoordinates :: Coordinates
opponentsCoordinates	= LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates
destination,
				Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
opponentsCoordinates MaybePieceByCoordinates
maybePieceByCoordinates Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Piece
pawn),
				Bool -> (Turn -> Bool) -> Maybe Turn -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False {-zero previous turns-} (
					(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Turn -> (Bool, Bool)) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
						(Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
opponentsCoordinates) (Coordinates -> Bool) -> (Move -> Coordinates) -> Move -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> Bool) -> (Move -> Bool) -> Move -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
							Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates
destination
						) (Coordinates -> Bool) -> (Move -> Coordinates) -> Move -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getSource
					 ) (Move -> (Bool, Bool)) -> (Turn -> Move) -> Turn -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove
				) (Maybe Turn -> Bool) -> Maybe Turn -> Bool
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
maybeLastTurn Game
game
		] {-List-comprehension. Include en-passant moves-} [QualifiedMove] -> [QualifiedMove] -> [QualifiedMove]
forall a. [a] -> [a] -> [a]
++ [
			Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (
				Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination
			) (MoveType -> QualifiedMove) -> MoveType -> QualifiedMove
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank |
				(Coordinates
source, Piece
piece)			<- LogicalColour
-> CoordinatesByRankByLogicalColour -> [(Coordinates, Piece)]
State.CoordinatesByRankByLogicalColour.findPiecesOfColour LogicalColour
logicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
				(Coordinates
destination, Maybe Rank
maybeTakenRank)	<- Coordinates
-> Piece -> MaybePieceByCoordinates -> [(Coordinates, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates
source Piece
piece MaybePieceByCoordinates
maybePieceByCoordinates,
				Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King,	-- This move can never be made; the option will either be immediately removed or check-mate declared.
				Maybe Rank
maybePromotionRank		<- Coordinates -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates
destination Piece
piece
		] -- List-comprehension.
	)
	where
		opponentsLogicalColour :: LogicalColour
opponentsLogicalColour						= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
		(MaybePieceByCoordinates
maybePieceByCoordinates, CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour)	= Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates (Board -> MaybePieceByCoordinates)
-> (Board -> CoordinatesByRankByLogicalColour)
-> Board
-> (MaybePieceByCoordinates, CoordinatesByRankByLogicalColour)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour (Board
 -> (MaybePieceByCoordinates, CoordinatesByRankByLogicalColour))
-> Board
-> (MaybePieceByCoordinates, CoordinatesByRankByLogicalColour)
forall a b. (a -> b) -> a -> b
$ Board
board
		isSafeQualifiedMove :: QualifiedMove -> Bool
isSafeQualifiedMove QualifiedMove
qualifiedMove				= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Move -> Board -> Bool
State.Board.exposesKing LogicalColour
logicalColour (QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove) Board
board

-- | Construct 'AvailableQualifiedMoves' for the player of the specified /logical colour/.
mkAvailableQualifiedMovesFor :: Attribute.LogicalColour.LogicalColour -> Game -> AvailableQualifiedMoves
mkAvailableQualifiedMovesFor :: LogicalColour -> Game -> AvailableQualifiedMoves
mkAvailableQualifiedMovesFor LogicalColour
logicalColour	= (QualifiedMove
 -> AvailableQualifiedMoves -> AvailableQualifiedMoves)
-> AvailableQualifiedMoves
-> [QualifiedMove]
-> AvailableQualifiedMoves
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr {-maintains destination-order-} (
	\QualifiedMove
qualifiedMove -> let
		move :: Move
move	= QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove
	in ([(Coordinates, MoveType)]
 -> [(Coordinates, MoveType)] -> [(Coordinates, MoveType)])
-> Coordinates
-> [(Coordinates, MoveType)]
-> AvailableQualifiedMoves
-> AvailableQualifiedMoves
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [(Coordinates, MoveType)]
-> [(Coordinates, MoveType)] -> [(Coordinates, MoveType)]
forall a. [a] -> [a] -> [a]
(++) (
		Move -> Coordinates
Component.Move.getSource Move
move	-- Key.
	) [
		(
			Move -> Coordinates
Component.Move.getDestination Move
move,
			QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove
		) -- Pair.
	] {-singleton-}
 ) AvailableQualifiedMoves
forall a. Empty a => a
Property.Empty.empty ([QualifiedMove] -> AvailableQualifiedMoves)
-> (Game -> [QualifiedMove]) -> Game -> AvailableQualifiedMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Game -> [QualifiedMove]
listQualifiedMovesAvailableTo LogicalColour
logicalColour

{- |
	* 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
	:: Attribute.LogicalColour.LogicalColour
	-> Game
	-> [Component.QualifiedMove.QualifiedMove]
findQualifiedMovesAvailableTo :: LogicalColour -> Game -> [QualifiedMove]
findQualifiedMovesAvailableTo LogicalColour
logicalColour game :: Game
game@MkGame { getAvailableQualifiedMovesByLogicalColour :: Game -> AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour }
	| Just AvailableQualifiedMoves
availableQualifiedMoves <- LogicalColour
-> AvailableQualifiedMovesByLogicalColour
-> Maybe AvailableQualifiedMoves
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup LogicalColour
logicalColour AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour	= [
		Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination) MoveType
moveType |
			(Coordinates
source, [(Coordinates, MoveType)]
qualifiedDestinations)	<- AvailableQualifiedMoves
-> [(Coordinates, [(Coordinates, MoveType)])]
forall k a. Map k a -> [(k, a)]
Map.toList AvailableQualifiedMoves
availableQualifiedMoves,
			(Coordinates
destination, MoveType
moveType)		<- [(Coordinates, MoveType)]
qualifiedDestinations
	] -- List-comprehension.
	| Bool
otherwise	= LogicalColour -> Game -> [QualifiedMove]
listQualifiedMovesAvailableTo LogicalColour
logicalColour Game
game	-- Generate the list of moves for this player.

-- | Count the number of plies available to the specified player.
countPliesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game -> Type.Count.NPlies
countPliesAvailableTo :: LogicalColour -> Game -> Int
countPliesAvailableTo LogicalColour
logicalColour game :: Game
game@MkGame { getAvailableQualifiedMovesByLogicalColour :: Game -> AvailableQualifiedMovesByLogicalColour
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour }
	| Game -> Bool
isTerminated Game
game	= Int
0
	| Just AvailableQualifiedMoves
availableQualifiedMoves	<- LogicalColour
-> AvailableQualifiedMovesByLogicalColour
-> Maybe AvailableQualifiedMoves
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup LogicalColour
logicalColour AvailableQualifiedMovesByLogicalColour
availableQualifiedMovesByLogicalColour	-- N.B.: 'findQualifiedMovesAvailableToNextPlayer' unnecessarily constructs a list.
	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> [(Coordinates, MoveType)] -> Int)
-> Int -> AvailableQualifiedMoves -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (\Int
acc -> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc) (Int -> Int)
-> ([(Coordinates, MoveType)] -> Int)
-> [(Coordinates, MoveType)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, MoveType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Int
0 AvailableQualifiedMoves
availableQualifiedMoves
	| Bool
otherwise		= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> ([QualifiedMove] -> Int) -> [QualifiedMove] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([QualifiedMove] -> Int) -> [QualifiedMove] -> Int
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Game -> [QualifiedMove]
listQualifiedMovesAvailableTo LogicalColour
logicalColour Game
game

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

-- | Let the specified player resign.
resignationBy :: Attribute.LogicalColour.LogicalColour -> Transformation
resignationBy :: LogicalColour -> Game -> Game
resignationBy LogicalColour
logicalColour Game
game
	| Game -> Bool
isTerminated Game
game	= Game
game	-- Already terminated.
	| Bool
otherwise		= Game
game {
		getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason	= GameTerminationReason -> Maybe GameTerminationReason
forall a. a -> Maybe a
Just (GameTerminationReason -> Maybe GameTerminationReason)
-> GameTerminationReason -> Maybe GameTerminationReason
forall a b. (a -> b) -> a -> b
$ LogicalColour -> GameTerminationReason
Rule.GameTerminationReason.mkResignation LogicalColour
logicalColour
	}

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

-- | Agree to a draw.
agreeToADraw :: Transformation
agreeToADraw :: Game -> Game
agreeToADraw Game
game
	| Game -> Bool
isTerminated Game
game	= Game
game	-- Already terminated.
	| Bool
otherwise		= Game
game {
		getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason	= GameTerminationReason -> Maybe GameTerminationReason
forall a. a -> Maybe a
Just (GameTerminationReason -> Maybe GameTerminationReason)
-> GameTerminationReason -> Maybe GameTerminationReason
forall a b. (a -> b) -> a -> b
$ DrawReason -> GameTerminationReason
Rule.GameTerminationReason.mkDraw DrawReason
Rule.DrawReason.byAgreement
	}

-- | Whether the game has been terminated.
isTerminated :: Game -> Bool
isTerminated :: Game -> Bool
isTerminated MkGame { getMaybeTerminationReason :: Game -> Maybe GameTerminationReason
getMaybeTerminationReason	= Maybe GameTerminationReason
maybeTerminationReason }	= Maybe GameTerminationReason -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe GameTerminationReason
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 -> Maybe GameTerminationReason
inferMaybeTerminationReason game :: Game
game@MkGame {
	getBoard :: Game -> Board
getBoard		= Board
board,
	getInstancesByPosition :: Game -> InstancesByPosition
getInstancesByPosition	= InstancesByPosition
instancesByPosition
}
	| Bool
haveZeroMoves
	, Just LogicalColour
logicalColour <- Game -> Maybe LogicalColour
getMaybeChecked Game
game	= GameTerminationReason -> Maybe GameTerminationReason
forall a. a -> Maybe a
Just (GameTerminationReason -> Maybe GameTerminationReason)
-> GameTerminationReason -> Maybe GameTerminationReason
forall a b. (a -> b) -> a -> b
$ LogicalColour -> GameTerminationReason
Rule.GameTerminationReason.mkCheckMate LogicalColour
logicalColour
	| Bool
otherwise					= (DrawReason -> GameTerminationReason)
-> Maybe DrawReason -> Maybe GameTerminationReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DrawReason -> GameTerminationReason
Rule.GameTerminationReason.mkDraw Maybe DrawReason
maybeDrawReason
	where
		haveZeroMoves :: Bool
		haveZeroMoves :: Bool
haveZeroMoves	= [QualifiedMove] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([QualifiedMove] -> Bool) -> [QualifiedMove] -> Bool
forall a b. (a -> b) -> a -> b
$ Game -> [QualifiedMove]
findQualifiedMovesAvailableToNextPlayer Game
game

		maybeDrawReason :: Maybe Rule.DrawReason.DrawReason
		maybeDrawReason :: Maybe DrawReason
maybeDrawReason
			| Bool
haveZeroMoves																= DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.staleMate
			| (Int -> Bool) -> InstancesByPosition -> Bool
forall position.
(Int -> Bool) -> InstancesByPosition position -> Bool
State.InstancesByPosition.anyInstancesByPosition (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Rule.DrawReason.maximumConsecutiveRepeatablePositions) InstancesByPosition
instancesByPosition	= DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.fiveFoldRepetition
			| InstancesByPosition -> Int
forall position. InstancesByPosition position -> Int
State.InstancesByPosition.countConsecutiveRepeatablePlies InstancesByPosition
instancesByPosition Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Rule.DrawReason.maximumConsecutiveRepeatablePlies	= DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.seventyFiveMoveRule
			| CoordinatesByRankByLogicalColour -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasInsufficientMaterial (CoordinatesByRankByLogicalColour -> Bool)
-> CoordinatesByRankByLogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour Board
board					= DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.insufficientMaterial
			| Bool
otherwise																= Maybe DrawReason
forall a. Maybe a
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 -> Game
updateTerminationReasonWith Result
result Game
game
	| Just LogicalColour
victorsLogicalColour <- Result -> Maybe LogicalColour
Rule.Result.findMaybeVictor Result
result	= LogicalColour -> Game -> Game
resignationBy (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
victorsLogicalColour) Game
game
	| Bool
otherwise								= Game -> Game
agreeToADraw Game
game

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

-- | Constructor.
mkPosition :: Game -> State.Position.Position
mkPosition :: Game -> Position
mkPosition game :: Game
game@MkGame {
	getNextLogicalColour :: Game -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
	getBoard :: Game -> Board
getBoard				= Board
board,
	getCastleableRooksByLogicalColour :: Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour
castleableRooksByLogicalColour
} = LogicalColour
-> MaybePieceByCoordinates
-> CastleableRooksByLogicalColour
-> Maybe Turn
-> Position
State.Position.mkPosition LogicalColour
nextLogicalColour (Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board) CastleableRooksByLogicalColour
castleableRooksByLogicalColour (Maybe Turn -> Position) -> Maybe Turn -> Position
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
maybeLastTurn Game
game

-- | Constructor. Count the instances of each repeatable /position/.
mkInstancesByPosition :: Game -> InstancesByPosition
mkInstancesByPosition :: Game -> InstancesByPosition
mkInstancesByPosition Game
game	= (Game -> Position) -> [Game] -> InstancesByPosition
forall (foldable :: * -> *) position a.
(Foldable foldable, Ord position) =>
(a -> position) -> foldable a -> InstancesByPosition position
State.InstancesByPosition.mkInstancesByPosition Game -> Position
mkPosition ([Game] -> InstancesByPosition)
-> ([(Game, Turn)] -> [Game])
-> [(Game, Turn)]
-> InstancesByPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game
game Game -> [Game] -> [Game]
forall a. a -> [a] -> [a]
:) ([Game] -> [Game])
-> ([(Game, Turn)] -> [Game]) -> [(Game, Turn)] -> [Game]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Game, Turn) -> Game) -> [(Game, Turn)] -> [Game]
forall a b. (a -> b) -> [a] -> [b]
map (Game, Turn) -> Game
forall a b. (a, b) -> a
fst {-game-} ([(Game, Turn)] -> [Game])
-> ([(Game, Turn)] -> [(Game, Turn)]) -> [(Game, Turn)] -> [Game]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Game, Turn) -> Bool) -> [(Game, Turn)] -> [(Game, Turn)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (
	Turn -> Bool
Component.Turn.getIsRepeatableMove (Turn -> Bool) -> ((Game, Turn) -> Turn) -> (Game, Turn) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game, Turn) -> Turn
forall a b. (a, b) -> b
snd {-turn-}
 ) ([(Game, Turn)] -> InstancesByPosition)
-> [(Game, Turn)] -> InstancesByPosition
forall a b. (a -> b) -> a -> b
$ Game -> [(Game, Turn)]
rollBack Game
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 =~ :: Game -> Game -> Bool
=~ Game
game'	= Game -> Position
mkPosition Game
game Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Game -> Position
mkPosition Game
game'

-- | Whether the state of the specified /game/s is different.
(/~) :: Game -> Game -> Bool
Game
game /~ :: Game -> Game -> Bool
/~ Game
game'	= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Game
game Game -> Game -> Bool
=~ 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 positionHash -> positionHash
updateIncrementalPositionHash Game
game positionHash
positionHash Game
game' Zobrist positionHash
zobrist	= positionHash -> [positionHash] -> positionHash
forall positionHash.
Bits positionHash =>
positionHash -> [positionHash] -> positionHash
StateProperty.Hashable.combine positionHash
positionHash ([positionHash] -> positionHash)
-> ([positionHash] -> [positionHash])
-> [positionHash]
-> positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
(++) [positionHash]
randomsFromMoveType ([positionHash] -> [positionHash])
-> ([positionHash] -> [positionHash])
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	let
		(CastleableRooksByLogicalColour
castleableRooksByLogicalColour, CastleableRooksByLogicalColour
castleableRooksByLogicalColour')	= ((Game -> CastleableRooksByLogicalColour)
-> Game -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ Game
game) ((Game -> CastleableRooksByLogicalColour)
 -> CastleableRooksByLogicalColour)
-> ((Game -> CastleableRooksByLogicalColour)
    -> CastleableRooksByLogicalColour)
-> (Game -> CastleableRooksByLogicalColour)
-> (CastleableRooksByLogicalColour, CastleableRooksByLogicalColour)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game -> CastleableRooksByLogicalColour)
-> Game -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ Game
game') ((Game -> CastleableRooksByLogicalColour)
 -> (CastleableRooksByLogicalColour,
     CastleableRooksByLogicalColour))
-> (Game -> CastleableRooksByLogicalColour)
-> (CastleableRooksByLogicalColour, CastleableRooksByLogicalColour)
forall a b. (a -> b) -> a -> b
$ Game -> CastleableRooksByLogicalColour
getCastleableRooksByLogicalColour
	in if Bool
isCastle Bool -> Bool -> Bool
|| CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= CastleableRooksByLogicalColour
castleableRooksByLogicalColour'
		then (
			CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> Zobrist positionHash
-> [positionHash]
forall random.
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Zobrist random -> [random]
State.CastleableRooksByLogicalColour.listIncrementalRandoms CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour' Zobrist positionHash
zobrist [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++
		) -- Section.
		else [positionHash] -> [positionHash]
forall a. a -> a
id
 ) ([positionHash] -> positionHash) -> [positionHash] -> positionHash
forall a b. (a -> b) -> a -> b
$ [
	positionHash
random |
		Just EnPassantAbscissa
enPassantAbscissa	<- (Game -> Maybe EnPassantAbscissa)
-> [Game] -> [Maybe EnPassantAbscissa]
forall a b. (a -> b) -> [a] -> [b]
map (
			\Game
g -> Game -> Maybe Turn
maybeLastTurn Game
g Maybe Turn
-> (Turn -> Maybe EnPassantAbscissa) -> Maybe EnPassantAbscissa
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour
-> MaybePieceByCoordinates -> Turn -> Maybe EnPassantAbscissa
State.EnPassantAbscissa.mkMaybeEnPassantAbscissa (
				Game -> LogicalColour
getNextLogicalColour Game
g
			) (
				Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates (Board -> MaybePieceByCoordinates)
-> Board -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ Game -> Board
getBoard Game
g
			) -- CAVEAT: accounts for any change to the En-passant option, rather than the act of taking En-passant.
		) [Game
game, Game
game'],
		positionHash
random			<- EnPassantAbscissa -> Zobrist positionHash -> [positionHash]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
StateProperty.Hashable.listRandoms EnPassantAbscissa
enPassantAbscissa Zobrist positionHash
zobrist
 ] {-list-comprehension-} [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++ Zobrist positionHash -> positionHash
forall positionHash. Zobrist positionHash -> positionHash
Component.Zobrist.getRandomForBlacksMove Zobrist positionHash
zobrist positionHash -> [positionHash] -> [positionHash]
forall a. a -> [a] -> [a]
: [
	Index -> Zobrist positionHash -> positionHash
forall positionHash. Index -> Zobrist positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (LogicalColour
lastLogicalColour, Turn -> Rank
rankAccessor Turn
turn, Move -> Coordinates
coordinatesAccessor Move
move) Zobrist positionHash
zobrist |
		(Turn -> Rank
rankAccessor, Move -> Coordinates
coordinatesAccessor)	<- [Turn -> Rank]
-> [Move -> Coordinates] -> [(Turn -> Rank, Move -> Coordinates)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Turn -> Rank
Component.Turn.getRank, (Rank -> Maybe Rank -> Rank
forall a. a -> Maybe a -> a
`Data.Maybe.fromMaybe` MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank MoveType
moveType) (Rank -> Rank) -> (Turn -> Rank) -> Turn -> Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> Rank
Component.Turn.getRank] [Move -> Coordinates]
coordinatesAccessors
 ] {-list-comprehension-} where
	lastLogicalColour :: LogicalColour
lastLogicalColour	= Game -> LogicalColour
getNextLogicalColour Game
game
	turn :: Turn
turn			= Turn -> Maybe Turn -> Turn
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
		Exception -> Turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn) -> Exception -> Turn
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkNullDatum String
"BishBosh.Model.Game.updateIncrementalPositionHash:\tzero turns have been made."
	 ) (Maybe Turn -> Turn) -> Maybe Turn -> Turn
forall a b. (a -> b) -> a -> b
$ Game -> Maybe Turn
maybeLastTurn Game
game'
	(Move
move, MoveType
moveType)	= QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> (Move, MoveType))
-> QualifiedMove -> (Move, MoveType)
forall a b. (a -> b) -> a -> b
$ Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
	isCastle :: Bool
isCastle		= MoveType -> Bool
Attribute.MoveType.isCastle MoveType
moveType
	coordinatesAccessors :: [Move -> Coordinates]
coordinatesAccessors	= [Move -> Coordinates
Component.Move.getSource, Move -> Coordinates
Component.Move.getDestination]

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