{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-
	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.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.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	BishBosh.Type.Length				as Type.Length
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
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
import qualified	Data.Map.Strict
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 x y	= State.InstancesByPosition.InstancesByPosition (State.Position.Position x y)

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

-- | Sort the lists of destinations to faciliate testing for equality.
sortAvailableQualifiedMoves :: (Ord x, Ord y) => AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
sortAvailableQualifiedMoves :: AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
sortAvailableQualifiedMoves	= ([(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map (([(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
 -> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> (((Coordinates x y, MoveType)
     -> (Coordinates x y, MoveType) -> Ordering)
    -> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> ((Coordinates x y, MoveType)
    -> (Coordinates x y, MoveType) -> Ordering)
-> AvailableQualifiedMoves x y
-> AvailableQualifiedMoves x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates x y, MoveType)
 -> (Coordinates x y, MoveType) -> Ordering)
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((Coordinates x y, MoveType)
  -> (Coordinates x y, MoveType) -> Ordering)
 -> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> ((Coordinates x y, MoveType)
    -> (Coordinates x y, MoveType) -> Ordering)
-> AvailableQualifiedMoves x y
-> AvailableQualifiedMoves x y
forall a b. (a -> b) -> a -> b
$ ((Coordinates x y, MoveType) -> Coordinates x y)
-> (Coordinates x y, MoveType)
-> (Coordinates x y, MoveType)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (Coordinates x y, MoveType) -> Coordinates x y
forall a b. (a, b) -> a
fst {-destination-}

-- | The /move/s available to both players.
type AvailableQualifiedMovesByLogicalColour x y	= Data.Map.Map Attribute.LogicalColour.LogicalColour (AvailableQualifiedMoves x y)

{- |
	* 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 x y	= MkGame {
	Game x y -> LogicalColour
getNextLogicalColour				:: Attribute.LogicalColour.LogicalColour,					-- ^ N.B.: can be derived from 'getTurnsByLogicalColour', unless 'Property.Reflectable.reflectOnX' has been called.
	Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour		:: State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour x,	-- ^ Those @Rook@s which can still participate in castling.
	Game x y -> Board x y
getBoard					:: State.Board.Board x y,							-- ^ The current state of the /board/.
	Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour				:: State.CastleableRooksByLogicalColour.TurnsByLogicalColour x y,		-- ^ Successive /move/s & any /piece/ taken, recorded by player.
	Game x y -> 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 x y -> InstancesByPosition x y
getInstancesByPosition				:: InstancesByPosition x y,							-- ^ The number of instances of various positions since the last unrepeatable move.
	Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour	:: AvailableQualifiedMovesByLogicalColour x y,					-- ^ 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 x y -> Maybe GameTerminationReason
getMaybeTerminationReason			:: Maybe Rule.GameTerminationReason.GameTerminationReason			-- ^ The reason (where appropriate) why the game was terminated.
}

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

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

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

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

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

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Property.ExtendedPositionDescription.ReadsEPD (Game x y) where
	{-# SPECIALISE instance Property.ExtendedPositionDescription.ReadsEPD (Game Type.Length.X Type.Length.Y) #-}
	readsEPD :: ReadS (Game x y)
readsEPD String
s	= [
		(
			LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
nextLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Board x y
board TurnsByLogicalColour x y
turnsByLogicalColour,
			String
s4
		) |
			(Board x y
board, String
s1)				<- ReadS (Board x y)
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 x
castleableRooksByLogicalColour, String
s3)	<- ReadS (CastleableRooksByLogicalColour x)
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD String
s2,
			(TurnsByLogicalColour x y
turnsByLogicalColour, String
s4)		<- case ShowS
Data.List.Extra.trimStart String
s3 of
				Char
'-' : String
s4'	-> [(TurnsByLogicalColour x y
forall a. Empty a => a
Property.Empty.empty {-TurnsByLogicalColour-}, String
s4')]
				String
s3'		-> (Coordinates x y -> TurnsByLogicalColour x y)
-> (Coordinates x y, String) -> (TurnsByLogicalColour x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
					\Coordinates x y
enPassantDestination -> let
						opponentsLogicalColour :: LogicalColour
opponentsLogicalColour	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
					in [(LogicalColour, [Turn x y])] -> TurnsByLogicalColour x y
forall turn.
Show turn =>
[(LogicalColour, [turn])] -> TurnsByLogicalColour turn
State.TurnsByLogicalColour.fromAssocs [
						(
							LogicalColour
nextLogicalColour,
							[]
						), (
							LogicalColour
opponentsLogicalColour,
							[
								QualifiedMove x y -> Rank -> Turn x y
forall x y. QualifiedMove x y -> Rank -> Turn x y
Component.Turn.mkTurn (
									Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
										(Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b. (a -> b) -> a -> b
$ (
											(LogicalColour -> Coordinates x y -> Coordinates x y)
-> (LogicalColour, Coordinates x y) -> Coordinates x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LogicalColour -> Coordinates x y -> Coordinates x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat ((LogicalColour, Coordinates x y) -> Coordinates x y)
-> ((LogicalColour, Coordinates x y) -> Coordinates x y)
-> (LogicalColour, Coordinates x y)
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (LogicalColour -> Coordinates x y -> Coordinates x y)
-> (LogicalColour, Coordinates x y) -> Coordinates x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LogicalColour -> Coordinates x y -> Coordinates x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance
										) (LogicalColour
opponentsLogicalColour, Coordinates x y
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 x y, String) -> (TurnsByLogicalColour x y, String))
-> [(Coordinates x y, String)]
-> [(TurnsByLogicalColour x y, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
ReadS (Coordinates x y)
Notation.PureCoordinate.readsCoordinates String
s3' -- En-passant destination.
	 ] -- List-comprehension.

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Property.ExtendedPositionDescription.ShowsEPD (Game x y) where
	showsEPD :: Game x y -> ShowS
showsEPD game :: Game x y
game@MkGame {
		getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
		getBoard :: forall x y. Game x y -> Board x y
getBoard				= Board x y
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 x y -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD Board x y
board,				-- 1. Placement of pieces.
		LogicalColour -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD LogicalColour
nextLogicalColour,		-- 2. Active colour.
		CastleableRooksByLogicalColour x -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,	-- 3. Castling availability.
		ShowS -> (Turn x y -> ShowS) -> Maybe (Turn x y) -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
Property.ExtendedPositionDescription.showsNullField (
			\Turn x y
turn -> if LogicalColour -> Turn x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Turn x y -> Bool
Component.Turn.isPawnDoubleAdvance (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) Turn x y
turn
				then MoveNotation -> Coordinates x y -> 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 x y -> ShowS)
-> (QualifiedMove x y -> Coordinates x y)
-> QualifiedMove x y
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour Transformation x y
-> (QualifiedMove x y -> Coordinates x y)
-> QualifiedMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Coordinates x y)
-> (QualifiedMove x y -> Move x y)
-> QualifiedMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> ShowS) -> QualifiedMove x y -> ShowS
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
				else ShowS
Property.ExtendedPositionDescription.showsNullField
		) (Maybe (Turn x y) -> ShowS) -> Maybe (Turn x y) -> ShowS
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
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 (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Property.ForsythEdwards.ReadsFEN (Game x y) where
	{-# SPECIALISE instance Property.ForsythEdwards.ReadsFEN (Game Type.Length.X Type.Length.Y) #-}
	readsFEN :: ReadS (Game x y)
readsFEN String
s	= [
		(Game x y
game, String
s3) |
			(Game x y
game, String
s1)		<- ReadS (Game x y)
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 (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Property.ForsythEdwards.ShowsFEN (Game x y) where
	showsFEN :: Game x y -> ShowS
showsFEN game :: Game x y
game@MkGame {
		getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour	= TurnsByLogicalColour x y
turnsByLogicalColour,
		getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition	= InstancesByPosition x y
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 x y -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD Game x y
game,
		Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ InstancesByPosition x y -> Int
forall position. InstancesByPosition position -> Int
State.InstancesByPosition.countConsecutiveRepeatablePlies InstancesByPosition x y
instancesByPosition, -- 5. Half move clock.
		Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> ([Turn x y] -> Int) -> [Turn x y] -> 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 x y] -> Int) -> [Turn x y] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Turn x y] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Turn x y] -> ShowS) -> [Turn x y] -> ShowS
forall a b. (a -> b) -> a -> b
$ LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
Attribute.LogicalColour.Black TurnsByLogicalColour x y
turnsByLogicalColour	-- 6. Full move counter.
	 ]

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Property.Empty.Empty (Game x y) where
	{-# SPECIALISE instance Property.Empty.Empty (Game Type.Length.X Type.Length.Y) #-}
	empty :: Game x y
empty	= Game x y
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 x y) where
	isNull :: Game x y -> Bool
isNull MkGame { getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour }	= TurnsByLogicalColour x y -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull TurnsByLogicalColour x y
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 (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Property.Reflectable.ReflectableOnX (Game x y) where
	{-# SPECIALISE instance Property.Reflectable.ReflectableOnX (Game Type.Length.X Type.Length.Y) #-}
	reflectOnX :: Game x y -> Game x y
reflectOnX MkGame {
		getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
		getBoard :: forall x y. Game x y -> Board x y
getBoard				= Board x y
board,
		getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour			= TurnsByLogicalColour x y
turnsByLogicalColour,
		getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition			= InstancesByPosition x y
instancesByPosition,
		getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason		= Maybe GameTerminationReason
maybeTerminationReason
	} = (
		LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame (
			LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
		) (
			CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX CastleableRooksByLogicalColour x
castleableRooksByLogicalColour
		) (
			Board x y -> Board x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Board x y
board
		) (
			TurnsByLogicalColour x y -> TurnsByLogicalColour x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX TurnsByLogicalColour x y
turnsByLogicalColour
		)
	 ) {
		getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition		= InstancesByPosition x y -> InstancesByPosition x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX InstancesByPosition x y
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 (Data.Array.IArray.Ix x, Enum x, Enum y, Ord y) => Component.Zobrist.Hashable2D Game x y {-CAVEAT: FlexibleInstances, MultiParamTypeClasses-} where
	{-# SPECIALISE instance Component.Zobrist.Hashable2D Game Type.Length.X Type.Length.Y #-}
	listRandoms2D :: Game x y -> Zobrist x y positionHash -> [positionHash]
listRandoms2D game :: Game x y
game@MkGame {
		getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
		getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
		getBoard :: forall x y. Game x y -> Board x y
getBoard				= Board x y
board
	} Zobrist x y positionHash
zobrist	= (
		if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
nextLogicalColour
			then (Zobrist x y positionHash -> positionHash
forall x y positionHash. Zobrist x y positionHash -> positionHash
Component.Zobrist.getRandomForBlacksMove Zobrist x y 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 x -> [positionHash] -> [positionHash])
-> Maybe (EnPassantAbscissa x)
-> [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 x -> [positionHash])
-> EnPassantAbscissa x
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnPassantAbscissa x -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
`Component.Zobrist.listRandoms1D` Zobrist x y positionHash
zobrist)
	 ) (
		Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game Maybe (Turn x y)
-> (Turn x y -> Maybe (EnPassantAbscissa x))
-> Maybe (EnPassantAbscissa x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
State.EnPassantAbscissa.mkMaybeEnPassantAbscissa LogicalColour
nextLogicalColour (
			Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
		)
	 ) ([positionHash] -> [positionHash])
-> [positionHash] -> [positionHash]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour x
-> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms1D CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Zobrist x y positionHash
zobrist [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++ Board x y -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> * -> *) x y positionHash.
Hashable2D hashable x y =>
hashable x y -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms2D Board x y
board Zobrist x y positionHash
zobrist

-- | Smart constructor.
mkGame :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> Attribute.LogicalColour.LogicalColour	-- ^ The player who is required to move next.
	-> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour x
	-> State.Board.Board x y
	-> State.CastleableRooksByLogicalColour.TurnsByLogicalColour x y
	-> Game x y
{-# SPECIALISE mkGame :: Attribute.LogicalColour.LogicalColour -> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour Type.Length.X -> State.Board.Board Type.Length.X Type.Length.Y -> State.CastleableRooksByLogicalColour.TurnsByLogicalColour Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y #-}
mkGame :: LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
nextLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Board x y
board TurnsByLogicalColour x y
turnsByLogicalColour
	| Bool -> Bool
not (Bool -> Bool)
-> (CoordinatesByRankByLogicalColour x y -> Bool)
-> CoordinatesByRankByLogicalColour x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRankByLogicalColour x y -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasBothKings (CoordinatesByRankByLogicalColour x y -> Bool)
-> CoordinatesByRankByLogicalColour x y -> Bool
forall a b. (a -> b) -> a -> b
$ Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
board	= Exception -> Game x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game x y)
-> (String -> Exception) -> String -> Game x y
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 x y) -> String -> Game x y
forall a b. (a -> b) -> a -> b
$ Board x y -> ShowS
forall a. Show a => a -> ShowS
shows Board x y
board String
"."
	| LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
State.Board.isKingChecked (
		LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
	) Board x y
board		= Exception -> Game x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game x y)
-> (String -> Exception) -> String -> Game x y
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 x y) -> String -> Game x y
forall a b. (a -> b) -> a -> b
$ Board x y -> ShowS
forall a. Show a => a -> ShowS
shows Board x y
board String
"."
	| Bool
otherwise	= Game x y
game
	where
		game :: Game x y
game = MkGame :: forall x y.
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Maybe LogicalColour
-> InstancesByPosition x y
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe GameTerminationReason
-> Game x y
MkGame {
			getNextLogicalColour :: LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour,
			getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
			getBoard :: Board x y
getBoard					= Board x y
board,
			getTurnsByLogicalColour :: TurnsByLogicalColour x y
getTurnsByLogicalColour				= TurnsByLogicalColour x y
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 x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
			getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition				= Position x y -> InstancesByPosition x y
forall position. position -> InstancesByPosition position
State.InstancesByPosition.mkSingleton (Position x y -> InstancesByPosition x y)
-> Position x y -> InstancesByPosition x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game,
			getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour	= [(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
				(LogicalColour
logicalColour, LogicalColour -> Game x y -> AvailableQualifiedMoves x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
logicalColour Game x y
game) |
					LogicalColour
logicalColour	<- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
					Game x y -> Maybe LogicalColour
forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked Game x y
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 x y -> Maybe GameTerminationReason
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> Maybe GameTerminationReason
inferMaybeTerminationReason Game x y
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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => State.Board.Board x y -> Game x y
{-# SPECIALISE fromBoard :: State.Board.Board Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y #-}
fromBoard :: Board x y -> Game x y
fromBoard Board x y
board	= LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
Attribute.LogicalColour.White (
	Board x y -> CastleableRooksByLogicalColour x
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x) =>
Board x y -> CastleableRooksByLogicalColour x
State.CastleableRooksByLogicalColour.fromBoard Board x y
board
 ) Board x y
board TurnsByLogicalColour x y
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 x y -> [Component.Turn.Turn x y]
listTurns :: Game x y -> [Turn x y]
listTurns MkGame {
	getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour	= LogicalColour
nextLogicalColour,
	getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour	= TurnsByLogicalColour x y
turnsByLogicalColour
} = ([Turn x y] -> [Turn x y] -> [Turn x y])
-> ([Turn x y], [Turn x y]) -> [Turn x y]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Turn x y] -> [Turn x y] -> [Turn x y]
forall a. [a] -> [a] -> [a]
ToolShed.Data.List.interleave (([Turn x y], [Turn x y]) -> [Turn x y])
-> ([Turn x y], [Turn x y]) -> [Turn x y]
forall a b. (a -> b) -> a -> b
$ (
	LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) (TurnsByLogicalColour x y -> [Turn x y])
-> (TurnsByLogicalColour x y -> [Turn x y])
-> TurnsByLogicalColour x y
-> ([Turn x y], [Turn x y])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
nextLogicalColour
 ) TurnsByLogicalColour x y
turnsByLogicalColour

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

-- | The last /turn/, if there was one.
maybeLastTurn :: Game x y -> Maybe (Component.Turn.Turn x y)
maybeLastTurn :: Game x y -> Maybe (Turn x y)
maybeLastTurn MkGame {
	getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour	= LogicalColour
nextLogicalColour,
	getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour	= TurnsByLogicalColour x y
turnsByLogicalColour
} = [Turn x y] -> Maybe (Turn x y)
forall a. [a] -> Maybe a
Data.Maybe.listToMaybe ([Turn x y] -> Maybe (Turn x y)) -> [Turn x y] -> Maybe (Turn x y)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (
	LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
 ) TurnsByLogicalColour x y
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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Attribute.LogicalColour.LogicalColour -> Game x y -> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE findAvailableCastlingMoves :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
findAvailableCastlingMoves :: LogicalColour -> Game x y -> [QualifiedMove x y]
findAvailableCastlingMoves LogicalColour
logicalColour MkGame {
	getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
	getBoard :: forall x y. Game x y -> Board x y
getBoard				= Board x y
board,
	getMaybeChecked :: forall x y. Game x y -> 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 [x]
rooksStartingXs	<- LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
forall x.
LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
State.CastleableRooksByLogicalColour.locateForLogicalColour LogicalColour
logicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour	= [
		Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
castlingKingsMove (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ CastlingMove x y -> MoveType
forall x y. CastlingMove x y -> MoveType
Component.CastlingMove.getMoveType CastlingMove x y
castlingMove |
			x
x		<- [x]
rooksStartingXs,
			CastlingMove x y
castlingMove	<- LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
Component.CastlingMove.getCastlingMoves LogicalColour
logicalColour,
			let castlingRooksSource :: Coordinates x y
castlingRooksSource	= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y) -> Move x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove CastlingMove x y
castlingMove,
			Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
castlingRooksSource x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
x,
			Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isClear (
				LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour
			) Coordinates x y
castlingRooksSource (MaybePieceByCoordinates x y -> Bool)
-> MaybePieceByCoordinates x y -> Bool
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board,
			let castlingKingsMove :: Move x y
castlingKingsMove	= CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove CastlingMove x y
castlingMove,
			(Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
				[(Coordinates x y, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates x y, Rank)] -> Bool)
-> (Coordinates x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Board x y -> [(Coordinates x y, Rank)])
-> Board x y -> [(Coordinates x y, Rank)]
forall a b. (a -> b) -> a -> b
$ Board x y
board) ((Board x y -> [(Coordinates x y, Rank)])
 -> [(Coordinates x y, Rank)])
-> (Coordinates x y -> Board x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> [(Coordinates x y, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour
			) ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Move x y -> [Coordinates x y]
Component.Move.interpolate Move x y
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
	:: (Enum y, Eq y)
	=> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.
	-> Component.Piece.Piece
	-> [Maybe Attribute.Rank.Rank]
{-# INLINE listMaybePromotionRanks #-}
listMaybePromotionRanks :: Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination Piece
piece
	| Coordinates x y -> Piece -> Bool
forall y x. (Enum y, Eq y) => Coordinates x y -> Piece -> Bool
Component.Piece.isPawnPromotion Coordinates x y
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 x y	= Game x y -> Game x y

{- |
	* 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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Component.Turn.Turn x y -> Transformation x y
{-# SPECIALISE takeTurn :: Component.Turn.Turn Type.Length.X Type.Length.Y -> Transformation Type.Length.X Type.Length.Y #-}
takeTurn :: Turn x y -> Transformation x y
takeTurn Turn x y
turn game :: Game x y
game@MkGame {
	getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour				= LogicalColour
nextLogicalColour,
	getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour		= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
	getBoard :: forall x y. Game x y -> Board x y
getBoard					= Board x y
board,
	getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour				= TurnsByLogicalColour x y
turnsByLogicalColour,
	getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition				= InstancesByPosition x y
instancesByPosition,
	getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour	= AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour
} = Bool -> Transformation x y
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 x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game	-- CAVEAT: otherwise any resignation will be overwritten.
 ) Game x y
game' where
	((Move x y
move, MoveType
moveType), Rank
sourceRank)	= (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove x y -> (Move x y, MoveType))
-> (Turn x y -> QualifiedMove x y)
-> Turn x y
-> (Move x y, MoveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove (Turn x y -> (Move x y, MoveType))
-> (Turn x y -> Rank) -> Turn x y -> ((Move x y, MoveType), Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank (Turn x y -> ((Move x y, MoveType), Rank))
-> Turn x y -> ((Move x y, MoveType), Rank)
forall a b. (a -> b) -> a -> b
$ Turn x y
turn	-- Deconstruct.
	(Coordinates x y
source, Coordinates x y
destination)		= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (Move x y -> Coordinates x y)
-> Move x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> (Coordinates x y, Coordinates x y))
-> Move x y -> (Coordinates x y, Coordinates x y)
forall a b. (a -> b) -> a -> b
$ Move x y
move	-- Deconstruct.

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

	inferredRooksMove :: Move x y
inferredRooksMove	= Move x y
-> (CastlingMove x y -> Move x y)
-> Maybe (CastlingMove x y)
-> Move x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
		Exception -> Move x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Move x y)
-> (String -> Exception) -> String -> Move x y
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 x y) -> String -> Move x y
forall a b. (a -> b) -> a -> b
$ (Move x y, MoveType) -> ShowS
forall a. Show a => a -> ShowS
shows (Move x y
move, MoveType
moveType) String
"."
	 ) CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove (Maybe (CastlingMove x y) -> Move x y)
-> ([CastlingMove x y] -> Maybe (CastlingMove x y))
-> [CastlingMove x y]
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CastlingMove x y -> Bool)
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
		(Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
== Move x y
move) (Move x y -> Bool)
-> (CastlingMove x y -> Move x y) -> CastlingMove x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove
	 ) ([CastlingMove x y] -> Move x y) -> [CastlingMove x y] -> Move x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
Component.CastlingMove.getCastlingMoves LogicalColour
nextLogicalColour

	board' :: Board x y
board'	= (
		if MoveType -> Bool
Attribute.MoveType.isCastle MoveType
moveType
			then Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
inferredRooksMove (Maybe MoveType -> Transformation x y)
-> Maybe MoveType -> Transformation x y
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 Transformation x y
forall a. a -> a
id
	 ) Transformation x y -> Transformation x y
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board x y
board

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

	game' :: Game x y
game' = Game x y
game {
		getNextLogicalColour :: LogicalColour
getNextLogicalColour				= LogicalColour
opponentsLogicalColour,
		getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour		= LogicalColour -> Turn x y -> Transformation x
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Turn x y -> Transformation x
State.CastleableRooksByLogicalColour.takeTurn LogicalColour
nextLogicalColour Turn x y
turn CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
		getBoard :: Board x y
getBoard					= Board x y
board',
		getTurnsByLogicalColour :: TurnsByLogicalColour x y
getTurnsByLogicalColour				= LogicalColour -> Turn x y -> Transformation (Turn x y)
forall turn. LogicalColour -> turn -> Transformation turn
State.TurnsByLogicalColour.prepend LogicalColour
nextLogicalColour Turn x y
turn TurnsByLogicalColour x y
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 x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board') [LogicalColour
opponentsLogicalColour],
		getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition				= Bool -> Position x y -> Transformation (Position x y)
forall position.
Ord position =>
Bool -> position -> Transformation position
State.InstancesByPosition.insertPosition (Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.getIsRepeatableMove Turn x y
turn) (Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game') InstancesByPosition x y
instancesByPosition,
		getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour	= let
			moveEndpoints :: [Coordinates x y]
moveEndpoints	= (
				case MoveType
moveType of
					Attribute.MoveType.Castle Bool
_	-> [Coordinates x y] -> [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a] -> [a]
(++) [
						Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
inferredRooksMove,
						Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
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 -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
nextLogicalColour Coordinates x y
destination Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
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 x y] -> [Coordinates x y]
forall a. a -> a
id
			 ) [Coordinates x y
source, Coordinates x y
destination]

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

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

-- | Construct a /turn/ & relay the request to 'takeTurn'.
applyQualifiedMove :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Component.QualifiedMove.QualifiedMove x y -> Transformation x y
{-# SPECIALISE applyQualifiedMove :: Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y -> Transformation Type.Length.X Type.Length.Y #-}
applyQualifiedMove :: QualifiedMove x y -> Transformation x y
applyQualifiedMove QualifiedMove x y
qualifiedMove game :: Game x y
game@MkGame { getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board }
	| Just Piece
piece	<- Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference (Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move) (MaybePieceByCoordinates x y -> Maybe Piece)
-> MaybePieceByCoordinates x y -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
	= Turn x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Turn x y -> Transformation x y
takeTurn (QualifiedMove x y -> Rank -> Turn x y
forall x y. QualifiedMove x y -> Rank -> Turn x y
Component.Turn.mkTurn QualifiedMove x y
qualifiedMove (Rank -> Turn x y) -> Rank -> Turn x y
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
piece) Game x y
game
	| Bool
otherwise	= Exception -> Game x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game x y)
-> (String -> Exception) -> String -> Game x y
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 x y -> ShowS
forall a. Show a => a -> ShowS
shows Move x y
move ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> Game x y) -> String -> Game x y
forall a b. (a -> b) -> a -> b
$ Game x y -> ShowS
forall a. Show a => a -> ShowS
shows Game x y
game String
"."
	where
		move :: Move x y
move	= QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove

-- | Construct a /qualifiedMove/ & relay the request to "applyQualifiedMove".
applyEitherQualifiedMove :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Component.EitherQualifiedMove.EitherQualifiedMove x y -> Transformation x y
{-# SPECIALISE applyEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y -> Transformation Type.Length.X Type.Length.Y #-}
applyEitherQualifiedMove :: EitherQualifiedMove x y -> Transformation x y
applyEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove game :: Game x y
game@MkGame { getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board } = QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
applyQualifiedMove (
	Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
move (MoveType -> QualifiedMove x y)
-> (Either (Maybe Rank) MoveType -> MoveType)
-> Either (Maybe Rank) MoveType
-> QualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		((MaybePieceByCoordinates x y -> MoveType)
-> MaybePieceByCoordinates x y -> MoveType
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board) ((MaybePieceByCoordinates x y -> MoveType) -> MoveType)
-> (Maybe Rank -> MaybePieceByCoordinates x y -> MoveType)
-> Maybe Rank
-> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
State.MaybePieceByCoordinates.inferMoveType Move x y
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 x y)
-> Either (Maybe Rank) MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
forall x y. EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
Component.EitherQualifiedMove.getPromotionRankOrMoveType EitherQualifiedMove x y
eitherQualifiedMove
 ) Game x y
game where
	move :: Move x y
move	= EitherQualifiedMove x y -> Move x y
forall x y. EitherQualifiedMove x y -> Move x y
Component.EitherQualifiedMove.getMove EitherQualifiedMove x y
eitherQualifiedMove

-- | Constructs /eitherQualifiedMove/s from the data provided, validating & applying each in the specified order.
applyEitherQualifiedMoves :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> (a -> Either String (Component.EitherQualifiedMove.EitherQualifiedMove x y))	-- ^ A constructor which can return an error-message.
	-> Game x y									-- ^ 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 x y)						-- ^ Either a rogue datum & the corresponding error-message, or the resulting /game/.
{-# SPECIALISE applyEitherQualifiedMoves :: (a -> Either String (Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y)) -> Game Type.Length.X Type.Length.Y -> [a] -> Either (a, String) (Game Type.Length.X Type.Length.Y) #-}
applyEitherQualifiedMoves :: (a -> Either String (EitherQualifiedMove x y))
-> Game x y -> [a] -> Either (a, String) (Game x y)
applyEitherQualifiedMoves a -> Either String (EitherQualifiedMove x y)
moveConstructor	= (Either (a, String) (Game x y)
 -> a -> Either (a, String) (Game x y))
-> Either (a, String) (Game x y)
-> [a]
-> Either (a, String) (Game x y)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
	\Either (a, String) (Game x y)
eitherGame a
datum -> Either (a, String) (Game x y)
eitherGame Either (a, String) (Game x y)
-> (Game x y -> Either (a, String) (Game x y))
-> Either (a, String) (Game x y)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (
		\Game x y
game -> (a, String) -> Either (a, String) (Game x y)
forall a b. a -> Either a b
Left ((a, String) -> Either (a, String) (Game x y))
-> (String -> (a, String))
-> String
-> Either (a, String) (Game x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
datum {-Constructor failed-} (String -> Either (a, String) (Game x y))
-> (EitherQualifiedMove x y -> Either (a, String) (Game x y))
-> Either String (EitherQualifiedMove x y)
-> Either (a, String) (Game x y)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (
			\EitherQualifiedMove x y
eitherQualifiedMove -> Either (a, String) (Game x y)
-> (String -> Either (a, String) (Game x y))
-> Maybe String
-> Either (a, String) (Game x y)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
				Game x y -> Either (a, String) (Game x y)
forall a b. b -> Either a b
Right (Game x y -> Either (a, String) (Game x y))
-> Game x y -> Either (a, String) (Game x y)
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
EitherQualifiedMove x y -> Transformation x y
applyEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove Game x y
game
			) (
				\String
errorMessage -> (a, String) -> Either (a, String) (Game x y)
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 x y -> ShowS
forall a. Show a => a -> ShowS
shows (Game x y -> Board x y
forall x y. Game x y -> Board x y
getBoard Game x y
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 x y))
-> Maybe String -> Either (a, String) (Game x y)
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
EitherQualifiedMove x y -> Game x y -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove Game x y
game
		) (Either String (EitherQualifiedMove x y)
 -> Either (a, String) (Game x y))
-> Either String (EitherQualifiedMove x y)
-> Either (a, String) (Game x y)
forall a b. (a -> b) -> a -> b
$ a -> Either String (EitherQualifiedMove x y)
moveConstructor a
datum
	)
 ) (Either (a, String) (Game x y)
 -> [a] -> Either (a, String) (Game x y))
-> (Game x y -> Either (a, String) (Game x y))
-> Game x y
-> [a]
-> Either (a, String) (Game x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Either (a, String) (Game x y)
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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> Component.QualifiedMove.QualifiedMove x y
	-> Game x y	-- ^ Prior to playing the /qualified move/.
	-> Maybe String	-- ^ Error-message.
{-# SPECIALISE validateQualifiedMove :: Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Maybe String #-}
validateQualifiedMove :: QualifiedMove x y -> Game x y -> Maybe String
validateQualifiedMove QualifiedMove x y
qualifiedMove game :: Game x y
game@MkGame {
	getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour		= LogicalColour
nextLogicalColour,
	getBoard :: forall x y. Game x y -> Board x y
getBoard			= Board x y
board,
	getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked			= Maybe LogicalColour
maybeChecked,
	getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason	= Maybe GameTerminationReason
maybeTerminationReason
} = Bool -> Maybe String -> Maybe String
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
	CoordinatesByRankByLogicalColour x y -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasBothKings (
		Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
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 x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
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 x y
destination Coordinates x y -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Coordinates x y -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
Component.Piece.findAttackDestinations Coordinates x y
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 x y
opponentsCoordinates	= LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
sourceLogicalColour Coordinates x y
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 x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
sourceLogicalColour Coordinates x y
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 x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isOccupied Coordinates x y
destination MaybePieceByCoordinates x y
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 x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
opponentsCoordinates MaybePieceByCoordinates x y
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 x y -> Bool) -> Maybe (Turn x y) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True {-zero previous turns-} (
										(
											Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove (LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
sourceLogicalColour Coordinates x y
destination) Coordinates x y
opponentsCoordinates
										) (Move x y -> Bool) -> (Turn x y -> Move x y) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
									) (Maybe (Turn x y) -> Bool) -> Maybe (Turn x y) -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
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 -> Int
forall distance. Vector distance -> distance
Cartesian.Vector.getXDistance Vector Int
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 -> Int
forall distance. Vector distance -> distance
Cartesian.Vector.getYDistance Vector Int
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 x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
sourceLogicalColour Coordinates x y
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 x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel Move x y
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 Int
distance Vector Int -> [Vector Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Vector Int]
forall distance. Num distance => [Vector distance]
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 x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal Move x y
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 x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight Move x y
move,
							String
"only straight moves are permissible"
						), (
							Bool
isObstructed,
							String
"an obstruction can't be jumped"
						)
					 ]
					Rank
Attribute.Rank.King
						| Vector Int
distance Vector Int -> [Vector Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vector Int]
forall distance. (Eq distance, Num distance) => [Vector distance]
Cartesian.Vector.attackVectorsForKing	-> []	-- i.e. a normal move.
						| Bool
otherwise {-castling-}				-> [(Bool, String)]
-> (CastlingMove x y -> [(Bool, String)])
-> Maybe (CastlingMove x y)
-> [(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 x y
rooksSource -> [
									(
										Bool -> Bool
not (Bool -> Bool)
-> (CastleableRooksByLogicalColour x -> Bool)
-> CastleableRooksByLogicalColour x
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> CastleableRooksByLogicalColour x -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> CastleableRooksByLogicalColour x -> Bool
State.CastleableRooksByLogicalColour.canCastleWith LogicalColour
sourceLogicalColour Coordinates x y
rooksSource (CastleableRooksByLogicalColour x -> Bool)
-> CastleableRooksByLogicalColour x -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> CastleableRooksByLogicalColour x
forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour Game x y
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 x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isObstructed Coordinates x y
source Coordinates x y
rooksSource MaybePieceByCoordinates x y
maybePieceByCoordinates,
										String
"it can't castle through an obstruction"
									)
								]
							) (Coordinates x y -> [(Bool, String)])
-> (CastlingMove x y -> Coordinates x y)
-> CastlingMove x y
-> [(Bool, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (CastlingMove x y -> Move x y)
-> CastlingMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove
						) (
							(CastlingMove x y -> Bool)
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
								(Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
== Move x y
move) (Move x y -> Bool)
-> (CastlingMove x y -> Move x y) -> CastlingMove x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove
							) ([CastlingMove x y] -> Maybe (CastlingMove x y))
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
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 x y] -> Bool) -> [Coordinates x y] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
									[(Coordinates x y, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates x y, Rank)] -> Bool)
-> (Coordinates x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Board x y -> [(Coordinates x y, Rank)])
-> Board x y -> [(Coordinates x y, Rank)]
forall a b. (a -> b) -> a -> b
$ Board x y
board) ((Board x y -> [(Coordinates x y, Rank)])
 -> [(Coordinates x y, Rank)])
-> (Coordinates x y -> Board x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> [(Coordinates x y, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
sourceLogicalColour
								) ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Move x y -> [Coordinates x y]
Component.Move.interpolate Move x y
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 x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
State.Board.isKingChecked LogicalColour
sourceLogicalColour (Board x y -> Bool) -> Board x y -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board x y
board,	-- CAVEAT: don't perform an unvalidated move at the Game-level.
						String
" remains checked"
					) -- Pair.
					else (
						LogicalColour -> Move x y -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Move x y -> Board x y -> Bool
State.Board.exposesKing LogicalColour
sourceLogicalColour Move x y
move Board x y
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 x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
source MaybePieceByCoordinates x y
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 x y
move, MoveType
moveType)	= QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y
qualifiedMove
	(Coordinates x y
source, Coordinates x y
destination)	= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (Move x y -> Coordinates x y)
-> Move x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> (Coordinates x y, Coordinates x y))
-> Move x y -> (Coordinates x y, Coordinates x y)
forall a b. (a -> b) -> a -> b
$ Move x y
move	-- Deconstruct.
	maybePieceByCoordinates :: MaybePieceByCoordinates x y
maybePieceByCoordinates	= Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
	maybeDestinationPiece :: Maybe Piece
maybeDestinationPiece	= Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates	-- Query.

	distance :: Cartesian.Vector.VectorInt
	distance :: Vector Int
distance	= Move x y -> Vector Int
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
Component.Move.measureDistance Move x y
move

	isObstructed :: Bool
	isObstructed :: Bool
isObstructed	= Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isObstructed Coordinates x y
source Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates

-- | Validates the /move-type/ then forwards the request to 'validateQualifiedMove'.
validateEitherQualifiedMove :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> Component.EitherQualifiedMove.EitherQualifiedMove x y
	-> Game x y	-- ^ Prior to playing the /move/.
	-> Maybe String	-- ^ Error-message.
{-# SPECIALISE validateEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Maybe String #-}
validateEitherQualifiedMove :: EitherQualifiedMove x y -> Game x y -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove game :: Game x y
game@MkGame { getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board }
	| Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isVacant (
		Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
	) MaybePieceByCoordinates x y
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 x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Game x y -> Maybe String
validateQualifiedMove (Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
move MoveType
inferredMoveType) Game x y
game
	where
		(Move x y
move, Either (Maybe Rank) MoveType
promotionRankOrMoveType)	= EitherQualifiedMove x y -> Move x y
forall x y. EitherQualifiedMove x y -> Move x y
Component.EitherQualifiedMove.getMove (EitherQualifiedMove x y -> Move x y)
-> (EitherQualifiedMove x y -> Either (Maybe Rank) MoveType)
-> EitherQualifiedMove x y
-> (Move x y, Either (Maybe Rank) MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
forall x y. EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
Component.EitherQualifiedMove.getPromotionRankOrMoveType (EitherQualifiedMove x y
 -> (Move x y, Either (Maybe Rank) MoveType))
-> EitherQualifiedMove x y
-> (Move x y, Either (Maybe Rank) MoveType)
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y
eitherQualifiedMove

		maybePieceByCoordinates :: MaybePieceByCoordinates x y
maybePieceByCoordinates		= Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board

		inferredMoveType :: Attribute.MoveType.MoveType
		inferredMoveType :: MoveType
inferredMoveType	= Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
State.MaybePieceByCoordinates.inferMoveType Move x y
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 x y
maybePieceByCoordinates

-- | Whether the specified /QualifiedMove/ is valid.
isValidQualifiedMove :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Component.QualifiedMove.QualifiedMove x y -> Game x y -> Bool
{-# SPECIALISE isValidQualifiedMove :: Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Bool #-}
isValidQualifiedMove :: QualifiedMove x y -> Game x y -> Bool
isValidQualifiedMove QualifiedMove x y
qualifiedMove	= Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool)
-> (Game x y -> Maybe String) -> Game x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Game x y -> Maybe String
validateQualifiedMove QualifiedMove x y
qualifiedMove

-- | Whether the specified /EitherQualifiedMove/ is valid.
isValidEitherQualifiedMove :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Component.EitherQualifiedMove.EitherQualifiedMove x y -> Game x y -> Bool
{-# SPECIALISE isValidEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Bool #-}
isValidEitherQualifiedMove :: EitherQualifiedMove x y -> Game x y -> Bool
isValidEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove	= Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool)
-> (Game x y -> Maybe String) -> Game x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherQualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
EitherQualifiedMove x y -> Game x y -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove x y
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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Game x y -> [(Game x y, Component.Turn.Turn x y)]
{-# SPECIALISE rollBack :: Game Type.Length.X Type.Length.Y -> [(Game Type.Length.X Type.Length.Y, Component.Turn.Turn Type.Length.X Type.Length.Y)] #-}
rollBack :: Game x y -> [(Game x y, Turn x y)]
rollBack	= (Game x y -> Maybe ((Game x y, Turn x y), Game x y))
-> Game x y -> [(Game x y, Turn x y)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
Data.List.unfoldr (
	\game :: Game x y
game@MkGame {
		getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour	= LogicalColour
nextLogicalColour,
		getBoard :: forall x y. Game x y -> Board x y
getBoard		= Board x y
board,
		getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour	= TurnsByLogicalColour x y
turnsByLogicalColour,
		getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition	= InstancesByPosition x y
instancesByPosition
	} -> let
		previousColour :: LogicalColour
previousColour	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
	 in case LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
previousColour TurnsByLogicalColour x y
turnsByLogicalColour of
		Turn x y
turn : [Turn x y]
previousTurns	-> let
			(Move x y
move, MoveType
moveType)	= (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn	-- Deconstruct.
			destination :: Coordinates x y
destination		= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move	-- Deconstruct.

			game' :: Game x y
game'@MkGame {
				getBoard :: forall x y. Game x y -> Board x y
getBoard		= Board x y
board',
				getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour	= TurnsByLogicalColour x y
turnsByLogicalColour',
				getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked		= Maybe LogicalColour
maybeChecked'
			} = Game x y
game {
				getNextLogicalColour :: LogicalColour
getNextLogicalColour			= LogicalColour
previousColour,
				getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour	= TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
forall x y.
(Enum x, Enum y, Eq x, Eq y) =>
TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour TurnsByLogicalColour x y
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 x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board') [LogicalColour
previousColour],
				getBoard :: Board x y
getBoard				= (
					case MoveType
moveType of
						Attribute.MoveType.Castle Bool
isShort	-> Move x y -> Maybe MoveType -> Board x y -> Board x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece (
							(Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b. (a -> b) -> a -> b
$ (
								(x -> x) -> Transformation x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX (
									if Bool
isShort then x -> x
forall a. Enum a => a -> a
pred else x -> x
forall a. Enum a => a -> a
succ
								) {-rook's source relative to the King-} Transformation x y
-> Transformation x y
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (x -> x) -> Transformation x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX (
									x -> x -> x
forall a b. a -> b -> a
const (x -> x -> x) -> x -> x -> x
forall a b. (a -> b) -> a -> b
$ if Bool
isShort then x
forall x. Enum x => x
Cartesian.Abscissa.xMax else x
forall x. Enum x => x
Cartesian.Abscissa.xMin
								) {-rook's destination-}
							) Coordinates x y
destination
						 ) (Maybe MoveType -> Board x y -> Board x y)
-> Maybe MoveType -> Board x y -> Board x y
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 x y -> Board x y -> Board x y
forall (mutator :: * -> * -> *) x y.
Mutator mutator x y =>
Piece -> Coordinates x y -> mutator x y -> mutator x y
StateProperty.Mutator.placePiece (
							LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
nextLogicalColour
						 ) (Coordinates x y -> Board x y -> Board x y)
-> Coordinates x y -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour Coordinates x y
destination	-- Re-instate the opponent's passing Pawn.
						MoveType
_ {-normal-}
							| MoveType -> Bool
Attribute.MoveType.isPromotion MoveType
moveType	-> Piece -> Coordinates x y -> Board x y -> Board x y
forall (mutator :: * -> * -> *) x y.
Mutator mutator x y =>
Piece -> Coordinates x y -> mutator x y -> mutator x y
StateProperty.Mutator.placePiece (
								LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
previousColour	-- Demote the piece just returned to the source of the move.
							) (Coordinates x y -> Board x y -> Board x y)
-> Coordinates x y -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
							| Bool
otherwise					-> Board x y -> Board x y
forall a. a -> a
id
				 ) (Board x y -> Board x y)
-> (Board x y -> Board x y) -> Board x y -> Board x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Board x y -> Board x y)
-> (Rank -> Board x y -> Board x y)
-> Maybe Rank
-> Board x y
-> Board x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Board x y -> Board x y
forall a. a -> a
id (
					(Piece -> Coordinates x y -> Board x y -> Board x y
forall (mutator :: * -> * -> *) x y.
Mutator mutator x y =>
Piece -> Coordinates x y -> mutator x y -> mutator x y
`StateProperty.Mutator.placePiece` Coordinates x y
destination) (Piece -> Board x y -> Board x y)
-> (Rank -> Piece) -> Rank -> Board x y -> Board x y
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 x y -> Board x y) -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Board x y -> Board x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece (Move x y -> Move x y
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Move x y
move) Maybe MoveType
forall a. Maybe a
Nothing {-MoveType-} Board x y
board,	-- N.B.: operate directly on the board to avoid creating a new Turn in the Game-structure.
				getTurnsByLogicalColour :: TurnsByLogicalColour x y
getTurnsByLogicalColour	= TurnsByLogicalColour x y
-> [(LogicalColour, [Turn x y])] -> TurnsByLogicalColour x y
forall turn.
TurnsByLogicalColour turn
-> [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
State.TurnsByLogicalColour.update TurnsByLogicalColour x y
turnsByLogicalColour [(LogicalColour
previousColour, [Turn x y]
previousTurns)],
				getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition	= if Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.getIsRepeatableMove Turn x y
turn
					then Position x y -> Transformation (Position x y)
forall position.
Ord position =>
position -> Transformation position
State.InstancesByPosition.deletePosition (Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game) InstancesByPosition x y
instancesByPosition
					else Game x y -> InstancesByPosition x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> InstancesByPosition x y
mkInstancesByPosition Game x y
game',	-- Reconstruct the map prior to the unrepeatable move.
				getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour	= [(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
					(LogicalColour
logicalColour, LogicalColour -> Game x y -> AvailableQualifiedMoves x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
logicalColour Game x y
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 x y, Turn x y), Game x y)
-> Maybe ((Game x y, Turn x y), Game x y)
forall a. a -> Maybe a
Just ((Game x y
game', Turn x y
turn), Game x y
game')
		[Turn x y]
_	-> Maybe ((Game x y, Turn x y), Game x y)
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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> Attribute.LogicalColour.LogicalColour	-- ^ Define the player for whom the moves are required.
	-> Game x y
	-> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE listQualifiedMovesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
listQualifiedMovesAvailableTo :: LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour game :: Game x y
game@MkGame {
	getBoard :: forall x y. Game x y -> Board x y
getBoard	= Board x y
board,
	getMaybeChecked :: forall x y. Game x y -> 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 x y
kingsCoordinates	= LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
forall x y.
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour
	in [
		Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
move MoveType
moveType |
			(Coordinates x y
destination, Maybe Rank
maybeTakenRank)	<- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
kingsCoordinates (LogicalColour -> Piece
Component.Piece.mkKing LogicalColour
logicalColour) MaybePieceByCoordinates x y
maybePieceByCoordinates,
			let
				move :: Move x y
move		= Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
kingsCoordinates Coordinates x y
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 x y, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates x y, Rank)] -> Bool)
-> (Board x y -> [(Coordinates x y, Rank)]) -> Board x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour Coordinates x y
destination (Board x y -> Bool) -> Board x y -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board x y
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 x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ case LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour Coordinates x y
kingsCoordinates Board x y
board of
		[(Coordinates x y
checkedFrom, Rank
checkedByRank)]	-> Bool -> [QualifiedMove x y] -> [QualifiedMove x y]
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 x y] -> [QualifiedMove x y])
-> ([QualifiedMove x y] -> [QualifiedMove x y])
-> [QualifiedMove x y]
-> [QualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove x y -> Bool)
-> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (a -> Bool) -> [a] -> [a]
filter QualifiedMove x y -> Bool
isSafeQualifiedMove ([QualifiedMove x y] -> [QualifiedMove x y])
-> [QualifiedMove x y] -> [QualifiedMove x y]
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 x y]
-> (Turn x y -> [QualifiedMove x y])
-> Maybe (Turn x y)
-> [QualifiedMove x y]
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 x y
lastMove -> let
							lastDestination :: Coordinates x y
lastDestination	= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
lastMove
							pawn :: Piece
pawn		= LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour
						in [
							Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
								Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates x y
lastDestination	-- Construct a move which takes the attacker.
							) MoveType
Attribute.MoveType.enPassant |
								LogicalColour -> Move x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Move x y -> Bool
Component.Move.isPawnDoubleAdvance LogicalColour
opponentsLogicalColour Move x y
lastMove,
								Coordinates x y
source	<- Coordinates x y -> [Coordinates x y]
forall x y. (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.getAdjacents Coordinates x y
lastDestination,
								Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
source MaybePieceByCoordinates x y
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 x y -> [QualifiedMove x y])
-> (Turn x y -> Move x y) -> Turn x y -> [QualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
				) (Maybe (Turn x y) -> [QualifiedMove x y])
-> Maybe (Turn x y) -> [QualifiedMove x y]
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
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 x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ [
			Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
				Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
checkedFrom	-- Construct a move which takes the attacker.
			) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
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 x y
source, Rank
attackersRank)	<- LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
opponentsLogicalColour Coordinates x y
checkedFrom Board x y
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 x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
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 x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ [
			Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
				Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
			) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
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 x y
source			<- LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
forall x y.
LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
rank CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,	-- Find the source of a potential blocking move.
				(Coordinates x y
destination, Maybe Rank
Nothing)	<- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
source Piece
piece MaybePieceByCoordinates x y
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 x y
checkedFrom Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
kingsCoordinates) (Bool -> Bool)
-> ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Coordinates x y
destination ([Coordinates x y] -> Bool)
-> ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a]
init {-drop King's location-} ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.interpolate Coordinates x y
checkedFrom Coordinates x y
kingsCoordinates,
				Maybe Rank
maybePromotionRank	<- Coordinates x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination Piece
piece
		 ] -- List-comprehension.
		[(Coordinates x y, Rank)]
attackers		-> Bool -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
			[(Coordinates x y, Rank)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Coordinates x y, 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 x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
findAvailableCastlingMoves LogicalColour
logicalColour Game x y
game [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ (QualifiedMove x y -> Bool)
-> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (a -> Bool) -> [a] -> [a]
filter QualifiedMove x y -> Bool
isSafeQualifiedMove (
		[
			Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
				Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
			) MoveType
Attribute.MoveType.enPassant |
				let pawn :: Piece
pawn	= LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour,
				Coordinates x y
source		<- LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
forall x y.
LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Pawn CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,
				LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
logicalColour Coordinates x y
source,
				Coordinates x y
destination	<- Coordinates x y -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
Component.Piece.findAttackDestinations Coordinates x y
source Piece
pawn,
				Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isVacant Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates,
				let opponentsCoordinates :: Coordinates x y
opponentsCoordinates	= LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates x y
destination,
				Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
opponentsCoordinates MaybePieceByCoordinates x y
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 x y -> Bool) -> Maybe (Turn x y) -> 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 x y -> (Bool, Bool)) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
						(Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
opponentsCoordinates) (Coordinates x y -> Bool)
-> (Move x y -> Coordinates x y) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Bool)
-> (Move x y -> Bool) -> Move x y -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
							Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates x y
destination
						) (Coordinates x y -> Bool)
-> (Move x y -> Coordinates x y) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource
					 ) (Move x y -> (Bool, Bool))
-> (Turn x y -> Move x y) -> Turn x y -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
				) (Maybe (Turn x y) -> Bool) -> Maybe (Turn x y) -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game
		] {-List-comprehension. Include en-passant moves-} [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ [
			Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
				Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
			) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank |
				(Coordinates x y
source, Piece
piece)			<- LogicalColour
-> CoordinatesByRankByLogicalColour x y
-> [(Coordinates x y, Piece)]
forall x y.
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> [LocatedPiece x y]
State.CoordinatesByRankByLogicalColour.findPiecesOfColour LogicalColour
logicalColour CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,
				(Coordinates x y
destination, Maybe Rank
maybeTakenRank)	<- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
source Piece
piece MaybePieceByCoordinates x y
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 x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination Piece
piece
		] -- List-comprehension.
	)
	where
		opponentsLogicalColour :: LogicalColour
opponentsLogicalColour						= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
		(MaybePieceByCoordinates x y
maybePieceByCoordinates, CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour)	= Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates (Board x y -> MaybePieceByCoordinates x y)
-> (Board x y -> CoordinatesByRankByLogicalColour x y)
-> Board x y
-> (MaybePieceByCoordinates x y,
    CoordinatesByRankByLogicalColour x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour (Board x y
 -> (MaybePieceByCoordinates x y,
     CoordinatesByRankByLogicalColour x y))
-> Board x y
-> (MaybePieceByCoordinates x y,
    CoordinatesByRankByLogicalColour x y)
forall a b. (a -> b) -> a -> b
$ Board x y
board
		isSafeQualifiedMove :: QualifiedMove x y -> Bool
isSafeQualifiedMove QualifiedMove x y
qualifiedMove				= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Move x y -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Move x y -> Board x y -> Bool
State.Board.exposesKing LogicalColour
logicalColour (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove) Board x y
board

-- | Construct 'AvailableQualifiedMoves' for the player of the specified /logical colour/.
mkAvailableQualifiedMovesFor :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Attribute.LogicalColour.LogicalColour -> Game x y -> AvailableQualifiedMoves x y
{-# SPECIALISE mkAvailableQualifiedMovesFor :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> AvailableQualifiedMoves Type.Length.X Type.Length.Y #-}
mkAvailableQualifiedMovesFor :: LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
logicalColour	= (QualifiedMove x y
 -> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> AvailableQualifiedMoves x y
-> [QualifiedMove x y]
-> AvailableQualifiedMoves x y
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr {-maintains destination-order-} (
	\QualifiedMove x y
qualifiedMove -> let
		move :: Move x y
move	= QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove
	in ([(Coordinates x y, MoveType)]
 -> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> Coordinates x y
-> [(Coordinates x y, MoveType)]
-> AvailableQualifiedMoves x y
-> AvailableQualifiedMoves x y
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.insertWith [(Coordinates x y, MoveType)]
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)]
forall a. [a] -> [a] -> [a]
(++) (
		Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move	-- Key.
	) [
		(
			Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move,
			QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove
		) -- Pair.
	] {-singleton-}
 ) AvailableQualifiedMoves x y
forall k a. Map k a
Data.Map.empty ([QualifiedMove x y] -> AvailableQualifiedMoves x y)
-> (Game x y -> [QualifiedMove x y])
-> Game x y
-> AvailableQualifiedMoves x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> Attribute.LogicalColour.LogicalColour
	-> Game x y
	-> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE findQualifiedMovesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
findQualifiedMovesAvailableTo :: LogicalColour -> Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableTo LogicalColour
logicalColour game :: Game x y
game@MkGame { getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour }
	| Just AvailableQualifiedMoves x y
availableQualifiedMoves <- LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe (AvailableQualifiedMoves x y)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup LogicalColour
logicalColour AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour	= [
		Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination) MoveType
moveType |
			(Coordinates x y
source, [(Coordinates x y, MoveType)]
qualifiedDestinations)	<- AvailableQualifiedMoves x y
-> [(Coordinates x y, [(Coordinates x y, MoveType)])]
forall k a. Map k a -> [(k, a)]
Data.Map.assocs AvailableQualifiedMoves x y
availableQualifiedMoves,
			(Coordinates x y
destination, MoveType
moveType)		<- [(Coordinates x y, MoveType)]
qualifiedDestinations
	] -- List-comprehension.
	| Bool
otherwise	= LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour Game x y
game	-- Generate the list of moves for this player.

-- | Count the number of plies available to the specified player.
countPliesAvailableTo :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Attribute.LogicalColour.LogicalColour -> Game x y -> Type.Count.NPlies
{-# SPECIALISE countPliesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> Type.Count.NPlies #-}
countPliesAvailableTo :: LogicalColour -> Game x y -> Int
countPliesAvailableTo LogicalColour
logicalColour game :: Game x y
game@MkGame { getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour }
	| Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game	= Int
0
	| Just AvailableQualifiedMoves x y
availableQualifiedMoves	<- LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe (AvailableQualifiedMoves x y)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup LogicalColour
logicalColour AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour	-- N.B.: 'findQualifiedMovesAvailableToNextPlayer' unnecessarily constructs a list.
--	= length $ Data.Foldable.concat availableQualifiedMoves			-- CAVEAT: terrible performance.
--	= Data.Map.foldl' (flip $ (+) . length) 0 availableQualifiedMoves	-- CAVEAT: poor performance.
	= 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 x y, MoveType)] -> Int)
-> Int -> AvailableQualifiedMoves x y -> Int
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Data.Map.Strict.foldl' (\Int
acc -> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc) (Int -> Int)
-> ([(Coordinates x y, MoveType)] -> Int)
-> [(Coordinates x y, MoveType)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates x y, MoveType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Int
0 AvailableQualifiedMoves x y
availableQualifiedMoves
	| Bool
otherwise	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int)
-> ([QualifiedMove x y] -> Int) -> [QualifiedMove x y] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove x y] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([QualifiedMove x y] -> Int) -> [QualifiedMove x y] -> Int
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour Game x y
game

-- | Retrieve the recorded value, or generate the list of /move/s available to the next player.
findQualifiedMovesAvailableToNextPlayer :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Game x y -> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE findQualifiedMovesAvailableToNextPlayer :: Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
findQualifiedMovesAvailableToNextPlayer :: Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableToNextPlayer game :: Game x y
game@MkGame { getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour }	= LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableTo LogicalColour
nextLogicalColour Game x y
game

-- | Let the specified player resign.
resignationBy :: Attribute.LogicalColour.LogicalColour -> Transformation x y
resignationBy :: LogicalColour -> Transformation x y
resignationBy LogicalColour
logicalColour Game x y
game
	| Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game	= Game x y
game	-- Already terminated.
	| Bool
otherwise		= Game x y
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 x y
resign :: Transformation x y
resign game :: Game x y
game@MkGame { getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour }	= LogicalColour -> Transformation x y
forall x y. LogicalColour -> Transformation x y
resignationBy LogicalColour
nextLogicalColour Game x y
game

-- | Agree to a draw.
agreeToADraw :: Transformation x y
agreeToADraw :: Transformation x y
agreeToADraw Game x y
game
	| Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game	= Game x y
game	-- Already terminated.
	| Bool
otherwise		= Game x y
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 x y -> Bool
isTerminated :: Game x y -> Bool
isTerminated MkGame { getMaybeTerminationReason :: forall x y. Game x y -> 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 :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Game x y -> Maybe Rule.GameTerminationReason.GameTerminationReason
{-# SPECIALISE inferMaybeTerminationReason :: Game Type.Length.X Type.Length.Y -> Maybe Rule.GameTerminationReason.GameTerminationReason #-}
inferMaybeTerminationReason :: Game x y -> Maybe GameTerminationReason
inferMaybeTerminationReason game :: Game x y
game@MkGame {
	getBoard :: forall x y. Game x y -> Board x y
getBoard		= Board x y
board,
	getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition	= InstancesByPosition x y
instancesByPosition
}
	| Bool
haveZeroMoves
	, Just LogicalColour
logicalColour <- Game x y -> Maybe LogicalColour
forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked Game x y
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 x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([QualifiedMove x y] -> Bool) -> [QualifiedMove x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableToNextPlayer Game x y
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 x y -> 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 x y
instancesByPosition	= DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.fiveFoldRepetition
			| InstancesByPosition x y -> Int
forall position. InstancesByPosition position -> Int
State.InstancesByPosition.countConsecutiveRepeatablePlies InstancesByPosition x y
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 x y -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasInsufficientMaterial (CoordinatesByRankByLogicalColour x y -> Bool)
-> CoordinatesByRankByLogicalColour x y -> Bool
forall a b. (a -> b) -> a -> b
$ Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
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 x y
updateTerminationReasonWith :: Result -> Transformation x y
updateTerminationReasonWith Result
result Game x y
game
	| Just LogicalColour
victorsLogicalColour <- Result -> Maybe LogicalColour
Rule.Result.findMaybeVictor Result
result	= LogicalColour -> Transformation x y
forall x y. LogicalColour -> Transformation x y
resignationBy (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
victorsLogicalColour) Game x y
game
	| Bool
otherwise								= Transformation x y
forall x y. Transformation x y
agreeToADraw Game x y
game

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

-- | Constructor.
mkPosition :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Game x y -> State.Position.Position x y
{-# SPECIALISE mkPosition :: Game Type.Length.X Type.Length.Y -> State.Position.Position Type.Length.X Type.Length.Y #-}
mkPosition :: Game x y -> Position x y
mkPosition game :: Game x y
game@MkGame {
	getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour			= LogicalColour
nextLogicalColour,
	getBoard :: forall x y. Game x y -> Board x y
getBoard				= Board x y
board,
	getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour	= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour
} = LogicalColour
-> MaybePieceByCoordinates x y
-> CastleableRooksByLogicalColour x
-> Maybe (Turn x y)
-> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> MaybePieceByCoordinates x y
-> CastleableRooksByLogicalColour x
-> Maybe (Turn x y)
-> Position x y
State.Position.mkPosition LogicalColour
nextLogicalColour (Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board) CastleableRooksByLogicalColour x
castleableRooksByLogicalColour (Maybe (Turn x y) -> Position x y)
-> Maybe (Turn x y) -> Position x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game

-- | Constructor. Count the instances of each repeatable /position/.
mkInstancesByPosition :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Game x y -> InstancesByPosition x y
{-# SPECIALISE mkInstancesByPosition :: Game Type.Length.X Type.Length.Y -> InstancesByPosition Type.Length.X Type.Length.Y #-}
mkInstancesByPosition :: Game x y -> InstancesByPosition x y
mkInstancesByPosition	= Map (Position x y) Int -> InstancesByPosition x y
forall position. Map position Int -> InstancesByPosition position
State.InstancesByPosition.mkInstancesByPosition (Map (Position x y) Int -> InstancesByPosition x y)
-> (Game x y -> Map (Position x y) Int)
-> Game x y
-> InstancesByPosition x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Position x y) Int
 -> [(Game x y, Turn x y)] -> Map (Position x y) Int)
-> (Map (Position x y) Int, [(Game x y, Turn x y)])
-> Map (Position x y) Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
	((Game x y, Turn x y)
 -> Map (Position x y) Int -> Map (Position x y) Int)
-> Map (Position x y) Int
-> [(Game x y, Turn x y)]
-> Map (Position x y) Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Game x y, Turn x y)
  -> Map (Position x y) Int -> Map (Position x y) Int)
 -> Map (Position x y) Int
 -> [(Game x y, Turn x y)]
 -> Map (Position x y) Int)
-> ((Game x y, Turn x y)
    -> Map (Position x y) Int -> Map (Position x y) Int)
-> Map (Position x y) Int
-> [(Game x y, Turn x y)]
-> Map (Position x y) Int
forall a b. (a -> b) -> a -> b
$ (Position x y
 -> Int -> Map (Position x y) Int -> Map (Position x y) Int)
-> Int
-> Position x y
-> Map (Position x y) Int
-> Map (Position x y) Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> Int -> Int)
-> Position x y
-> Int
-> Map (Position x y) Int
-> Map (Position x y) Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.Strict.insertWith ((Int -> Int -> Int)
 -> Position x y
 -> Int
 -> Map (Position x y) Int
 -> Map (Position x y) Int)
-> (Int -> Int -> Int)
-> Position x y
-> Int
-> Map (Position x y) Int
-> Map (Position x y) Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. Enum a => a -> a
succ) Int
1 (Position x y -> Map (Position x y) Int -> Map (Position x y) Int)
-> ((Game x y, Turn x y) -> Position x y)
-> (Game x y, Turn x y)
-> Map (Position x y) Int
-> Map (Position x y) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition (Game x y -> Position x y)
-> ((Game x y, Turn x y) -> Game x y)
-> (Game x y, Turn x y)
-> Position x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game x y, Turn x y) -> Game x y
forall a b. (a, b) -> a
fst {-game-}
 ) ((Map (Position x y) Int, [(Game x y, Turn x y)])
 -> Map (Position x y) Int)
-> (Game x y -> (Map (Position x y) Int, [(Game x y, Turn x y)]))
-> Game x y
-> Map (Position x y) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
	(Position x y -> Int -> Map (Position x y) Int
forall k a. k -> a -> Map k a
`Data.Map.Strict.singleton` Int
1) (Position x y -> Map (Position x y) Int)
-> (Game x y -> Position x y) -> Game x y -> Map (Position x y) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition (Game x y -> Map (Position x y) Int)
-> (Game x y -> [(Game x y, Turn x y)])
-> Game x y
-> (Map (Position x y) Int, [(Game x y, Turn x y)])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game x y, Turn x y) -> Bool)
-> [(Game x y, Turn x y)] -> [(Game x y, Turn x y)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (
		Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.getIsRepeatableMove (Turn x y -> Bool)
-> ((Game x y, Turn x y) -> Turn x y)
-> (Game x y, Turn x y)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game x y, Turn x y) -> Turn x y
forall a b. (a, b) -> b
snd {-turn-}
	) ([(Game x y, Turn x y)] -> [(Game x y, Turn x y)])
-> (Game x y -> [(Game x y, Turn x y)])
-> Game x y
-> [(Game x y, Turn x y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> [(Game x y, Turn x y)]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> [(Game x y, Turn x y)]
rollBack
 )

{- |
	* 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/.
-}
(=~) :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Game x y -> Game x y -> Bool
{-# SPECIALISE (=~) :: Game Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Bool #-}
Game x y
game =~ :: Game x y -> Game x y -> Bool
=~ Game x y
game'	= Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game Position x y -> Position x y -> Bool
forall a. Eq a => a -> a -> Bool
== Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game'

-- | Whether the state of the specified /game/s is different.
(/~) :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Game x y -> Game x y -> Bool
Game x y
game /~ :: Game x y -> Game x y -> Bool
/~ Game x y
game'	= Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y
game Game x y -> Game x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Game x y -> Bool
=~ Game x y
game'

-- | Update the /position-hash/ of the /game/ prior to application of the last /move/.
updateIncrementalPositionHash :: (
	Data.Array.IArray.Ix	x,
	Data.Bits.Bits		positionHash,
	Enum			x,
	Enum			y,
	Ord			y
 )
	=> Game x y		-- ^ The /game/ before application of the last move.
	-> positionHash		-- ^ The value before application of the last move.
	-> Game x y		-- ^ The current game.
	-> Component.Zobrist.Zobrist x y positionHash
	-> positionHash
{-# SPECIALISE updateIncrementalPositionHash :: Game Type.Length.X Type.Length.Y -> Type.Crypto.PositionHash -> Game Type.Length.X Type.Length.Y -> Component.Zobrist.Zobrist Type.Length.X Type.Length.Y Type.Crypto.PositionHash -> Type.Crypto.PositionHash #-}
updateIncrementalPositionHash :: Game x y
-> positionHash
-> Game x y
-> Zobrist x y positionHash
-> positionHash
updateIncrementalPositionHash Game x y
game positionHash
positionHash Game x y
game' Zobrist x y positionHash
zobrist	= positionHash -> [positionHash] -> positionHash
forall positionHash.
Bits positionHash =>
positionHash -> [positionHash] -> positionHash
Component.Zobrist.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 x
castleableRooksByLogicalColour, CastleableRooksByLogicalColour x
castleableRooksByLogicalColour')	= ((Game x y -> CastleableRooksByLogicalColour x)
-> Game x y -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ Game x y
game) ((Game x y -> CastleableRooksByLogicalColour x)
 -> CastleableRooksByLogicalColour x)
-> ((Game x y -> CastleableRooksByLogicalColour x)
    -> CastleableRooksByLogicalColour x)
-> (Game x y -> CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x,
    CastleableRooksByLogicalColour x)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game x y -> CastleableRooksByLogicalColour x)
-> Game x y -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ Game x y
game') ((Game x y -> CastleableRooksByLogicalColour x)
 -> (CastleableRooksByLogicalColour x,
     CastleableRooksByLogicalColour x))
-> (Game x y -> CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x,
    CastleableRooksByLogicalColour x)
forall a b. (a -> b) -> a -> b
$ Game x y -> CastleableRooksByLogicalColour x
forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour
	in if Bool
isCastle Bool -> Bool -> Bool
|| CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
forall a. Eq a => a -> a -> Bool
/= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour'
		then (
			CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Zobrist x y positionHash
-> [positionHash]
forall x y random.
Ix x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Zobrist x y random
-> [random]
State.CastleableRooksByLogicalColour.listIncrementalRandoms CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour' Zobrist x y 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 x
enPassantAbscissa	<- (Game x y -> Maybe (EnPassantAbscissa x))
-> [Game x y] -> [Maybe (EnPassantAbscissa x)]
forall a b. (a -> b) -> [a] -> [b]
map (
			\Game x y
g -> Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
g Maybe (Turn x y)
-> (Turn x y -> Maybe (EnPassantAbscissa x))
-> Maybe (EnPassantAbscissa x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
State.EnPassantAbscissa.mkMaybeEnPassantAbscissa (
				Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
getNextLogicalColour Game x y
g
			) (
				Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates (Board x y -> MaybePieceByCoordinates x y)
-> Board x y -> MaybePieceByCoordinates x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Board x y
forall x y. Game x y -> Board x y
getBoard Game x y
g
			) -- CAVEAT: accounts for any change to the En-passant option, rather than the act of taking En-passant.
		) [Game x y
game, Game x y
game'],
		positionHash
random			<- EnPassantAbscissa x -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms1D EnPassantAbscissa x
enPassantAbscissa Zobrist x y positionHash
zobrist
 ] {-list-comprehension-} [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++ Zobrist x y positionHash -> positionHash
forall x y positionHash. Zobrist x y positionHash -> positionHash
Component.Zobrist.getRandomForBlacksMove Zobrist x y positionHash
zobrist positionHash -> [positionHash] -> [positionHash]
forall a. a -> [a] -> [a]
: [
	Index x y -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y) =>
Index x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (LogicalColour
lastLogicalColour, Turn x y -> Rank
rankAccessor Turn x y
turn, Move x y -> Coordinates x y
coordinatesAccessor Move x y
move) Zobrist x y positionHash
zobrist |
		(Turn x y -> Rank
rankAccessor, Move x y -> Coordinates x y
coordinatesAccessor)	<- [Turn x y -> Rank]
-> [Move x y -> Coordinates x y]
-> [(Turn x y -> Rank, Move x y -> Coordinates x y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Turn x y -> Rank
forall x y. Turn x y -> 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 x y -> Rank) -> Turn x y -> Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank] [Move x y -> Coordinates x y]
forall x y. [Move x y -> Coordinates x y]
coordinatesAccessors
 ] {-list-comprehension-} where
	lastLogicalColour :: LogicalColour
lastLogicalColour	= Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
getNextLogicalColour Game x y
game
	turn :: Turn x y
turn			= Turn x y -> Maybe (Turn x y) -> Turn x y
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
		Exception -> Turn x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn x y) -> Exception -> Turn x y
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkNullDatum String
"BishBosh.Model.Game.updateIncrementalPositionHash:\tzero turns have been made."
	 ) (Maybe (Turn x y) -> Turn x y) -> Maybe (Turn x y) -> Turn x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game'
	(Move x y
move, MoveType
moveType)	= QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
	isCastle :: Bool
isCastle		= MoveType -> Bool
Attribute.MoveType.isCastle MoveType
moveType
	coordinatesAccessors :: [Move x y -> Coordinates x y]
coordinatesAccessors	= [Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource, Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination]

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