{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	The abscissae of those @Rook@s, for the player of each /logicalColour/, which can still participate in castling.
-}

module BishBosh.State.CastleableRooksByLogicalColour(
-- * Types
-- ** Type-synonyms
--	AbscissaeByLogicalColour,
	TurnsByLogicalColour,
--	Transformation,
-- ** Data-types
	CastleableRooksByLogicalColour(),
-- * Functions
--	sortByLogicalColour,
--	inferRooksCoordinates,
	locateForLogicalColour,
-- ** Constructors
	fromAssocs,
	fromBoard,
	fromTurnsByLogicalColour,
	listIncrementalRandoms,
-- ** Mutators
--	castle,
--	relinquishCastlingRights,
--	removeX,
	unify,
	takeTurn,
-- ** Predicates
	hasCastled,
	canCastle,
--	canCastleWith',
	canCastleWith,
	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.Ordinate			as Cartesian.Ordinate
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.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.Opposable			as Property.Opposable
import qualified	BishBosh.Property.Reflectable			as Property.Reflectable
import qualified	BishBosh.State.Board				as State.Board
import qualified	BishBosh.State.CoordinatesByRankByLogicalColour	as State.CoordinatesByRankByLogicalColour
import qualified	BishBosh.StateProperty.Hashable			as StateProperty.Hashable
import qualified	BishBosh.State.TurnsByLogicalColour		as State.TurnsByLogicalColour
import qualified	BishBosh.Type.Length				as Type.Length
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Char
import qualified	Data.Default
import qualified	Data.List
import qualified	Data.List.Extra
import qualified	Data.Maybe
import qualified	Data.Ord

{- |
	* For the players of each /logical colour/, identifies the abscissae of those @Rook@s which can still participate in castling (when other constraints are removed).

	* Lack of an entry for the specified /logical colour/ implies that castling has already occurred, whereas a null list of abscissae implies that castling can no longer happen.

	* N.B.: both the outer list (indexed by logical colour) & the inner list of abscissae, are kept ordered, otherwise the derived instance of 'Eq' would be unpredictable.
-}
type AbscissaeByLogicalColour	= [(Attribute.LogicalColour.LogicalColour, [Type.Length.X])]

-- | Ensure a predictable order, to facilitate '(==)'.
sortByLogicalColour :: AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour :: AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour	= ((LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering)
 -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering)
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst {-logicalColour-}

-- | Update to account for the specified player castling.
castle :: Attribute.LogicalColour.LogicalColour -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
castle :: LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
castle LogicalColour
logicalColour	= ((LogicalColour, [X]) -> Bool)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. (a -> Bool) -> [a] -> [a]
filter (((LogicalColour, [X]) -> Bool)
 -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> Bool)
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour) (LogicalColour -> Bool)
-> ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst {-logicalColour-}	-- N.B.: if 'Data.List.deleteBy' took a simple predicate, it would have been ideal.

-- | Update to account for the specified player losing the right to castle.
relinquishCastlingRights :: Attribute.LogicalColour.LogicalColour -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
relinquishCastlingRights :: LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
relinquishCastlingRights LogicalColour
logicalColour	= ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (((LogicalColour, [X]) -> (LogicalColour, [X]))
 -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ \pair :: (LogicalColour, [X])
pair@(LogicalColour
logicalColour', [X]
_) -> (
	if LogicalColour
logicalColour' LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour
		then ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X]))
-> ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall a b. (a -> b) -> a -> b
$ [X] -> [X] -> [X]
forall a b. a -> b -> a
const []
		else (LogicalColour, [X]) -> (LogicalColour, [X])
forall a. a -> a
id
 ) (LogicalColour, [X])
pair

-- | Remove the right to castle, from the referenced @Rook@.
removeX
	:: Attribute.LogicalColour.LogicalColour
	-> Type.Length.X
	-> AbscissaeByLogicalColour
	-> AbscissaeByLogicalColour
removeX :: LogicalColour
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
removeX LogicalColour
logicalColour X
x	= ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (((LogicalColour, [X]) -> (LogicalColour, [X]))
 -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ \pair :: (LogicalColour, [X])
pair@(LogicalColour
logicalColour', [X]
_) -> (
	if LogicalColour
logicalColour' LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour
		then ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X]))
-> ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall a b. (a -> b) -> a -> b
$ X -> [X] -> [X]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete X
x
		else (LogicalColour, [X]) -> (LogicalColour, [X])
forall a. a -> a
id
 ) (LogicalColour, [X])
pair

-- | Predicate.
canCastleWith'
	:: Attribute.LogicalColour.LogicalColour
	-> Type.Length.X	-- ^ @Rook@'s abscissa.
	-> AbscissaeByLogicalColour
	-> Bool
canCastleWith' :: LogicalColour -> X -> AbscissaeByLogicalColour -> Bool
canCastleWith' LogicalColour
logicalColour X
x	= Bool -> ([X] -> Bool) -> Maybe [X] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False {-has castled-} (X -> [X] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem X
x) (Maybe [X] -> Bool)
-> (AbscissaeByLogicalColour -> Maybe [X])
-> AbscissaeByLogicalColour
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour

-- | For the players of each /logical colour/, identifies the abscissae of those @Rook@s which can still participate in castling (when other constraints are removed).
newtype CastleableRooksByLogicalColour	= MkCastleableRooksByLogicalColour {
	CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs	:: AbscissaeByLogicalColour
} deriving (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
(CastleableRooksByLogicalColour
 -> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour -> Bool)
-> Eq CastleableRooksByLogicalColour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c/= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
== :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c== :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
Eq, Eq CastleableRooksByLogicalColour
Eq CastleableRooksByLogicalColour
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour -> Ordering)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour)
-> (CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour
    -> CastleableRooksByLogicalColour)
-> Ord CastleableRooksByLogicalColour
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
$cmin :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
max :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
$cmax :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
>= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c>= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
> :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c> :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
<= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c<= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
< :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c< :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
compare :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering
$ccompare :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering
$cp1Ord :: Eq CastleableRooksByLogicalColour
Ord)

instance Show CastleableRooksByLogicalColour where
	showsPrec :: X -> CastleableRooksByLogicalColour -> ShowS
showsPrec X
precedence MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= X -> AbscissaeByLogicalColour -> ShowS
forall a. Show a => X -> a -> ShowS
showsPrec X
precedence AbscissaeByLogicalColour
assocs

instance Read CastleableRooksByLogicalColour where
	readsPrec :: X -> ReadS CastleableRooksByLogicalColour
readsPrec X
precedence String
s	= (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> (AbscissaeByLogicalColour, String)
-> (CastleableRooksByLogicalColour, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs ((AbscissaeByLogicalColour, String)
 -> (CastleableRooksByLogicalColour, String))
-> [(AbscissaeByLogicalColour, String)]
-> [(CastleableRooksByLogicalColour, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` X -> ReadS AbscissaeByLogicalColour
forall a. Read a => X -> ReadS a
readsPrec X
precedence String
s

instance Control.DeepSeq.NFData CastleableRooksByLogicalColour where
	rnf :: CastleableRooksByLogicalColour -> ()
rnf MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= AbscissaeByLogicalColour -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf AbscissaeByLogicalColour
assocs

instance Data.Default.Default CastleableRooksByLogicalColour where
	def :: CastleableRooksByLogicalColour
def = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, [X]))
-> [LogicalColour] -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (
		(LogicalColour -> [X] -> (LogicalColour, [X]))
-> [X] -> LogicalColour -> (LogicalColour, [X])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [X
Cartesian.Abscissa.xMin, X
Cartesian.Abscissa.xMax]
	 ) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

instance Property.Reflectable.ReflectableOnX CastleableRooksByLogicalColour where
	reflectOnX :: CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
reflectOnX MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. [a] -> [a]
reverse (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (
		(LogicalColour -> LogicalColour)
-> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite
	 ) AbscissaeByLogicalColour
assocs

instance Property.ExtendedPositionDescription.ReadsEPD CastleableRooksByLogicalColour where
	readsEPD :: ReadS CastleableRooksByLogicalColour
readsEPD String
s	= case ShowS
Data.List.Extra.trimStart String
s of
		Char
'-' : String
remainder	-> [
			(
				AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members [LogicalColour] -> [[X]] -> AbscissaeByLogicalColour
forall a b. [a] -> [b] -> [(a, b)]
`zip` [X] -> [[X]]
forall a. a -> [a]
repeat [],	-- CAVEAT: can't disambiguate between this potential value & '[]' which have different semantics for this application.
				String
remainder
			) -- Pair.
		 ] -- Singleton.
		String
s1		-> let
			readsAssocs :: String -> [([(LogicalColour, X)], String)]
readsAssocs String
s'
				| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s' Bool -> Bool -> Bool
|| Char -> Bool
Data.Char.isSpace (String -> Char
forall a. [a] -> a
head String
s')	= [([(LogicalColour, X)], String)]
forall a. [([a], String)]
terminate	-- CAVEAT: white space separates this field from the start of the En-passant destination, which should it begin with a 'b' might be interpreted as a Bishop.
				| Bool
otherwise					= case ReadS Piece
forall a. Read a => ReadS a
reads String
s' of
					[(Piece
piece, String
s'')]	-> case Piece -> Rank
Component.Piece.getRank Piece
piece of
						Rank
Attribute.Rank.Queen	-> ([(LogicalColour, X)] -> [(LogicalColour, X)])
-> ([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
							(
								LogicalColour
logicalColour,
								X
Cartesian.Abscissa.xMin
							) (LogicalColour, X) -> [(LogicalColour, X)] -> [(LogicalColour, X)]
forall a. a -> [a] -> [a]
: {-prepend-}
						 ) (([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String))
-> [([(LogicalColour, X)], String)]
-> [([(LogicalColour, X)], String)]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [([(LogicalColour, X)], String)]
readsAssocs String
s''	-- Recurse.
						Rank
Attribute.Rank.King	-> ([(LogicalColour, X)] -> [(LogicalColour, X)])
-> ([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
							(
								LogicalColour
logicalColour,
								X
Cartesian.Abscissa.xMax
							) (LogicalColour, X) -> [(LogicalColour, X)] -> [(LogicalColour, X)]
forall a. a -> [a] -> [a]
: {-prepend-}
						 ) (([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String))
-> [([(LogicalColour, X)], String)]
-> [([(LogicalColour, X)], String)]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [([(LogicalColour, X)], String)]
readsAssocs String
s''	-- Recurse.
						Rank
_			-> []	-- Inappropriate rank => parse-failure.
						where
							logicalColour :: LogicalColour
logicalColour	= Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece
					[(Piece, String)]
_		-> [([(LogicalColour, X)], String)]
forall a. [([a], String)]
terminate
				where
					terminate :: [([a], String)]
terminate	= [([], String
s')]
		 in case String -> [([(LogicalColour, X)], String)]
readsAssocs String
s1 of
			[([], String
_)]	-> []	-- Zero pieces were read => parse-failure.
			[([(LogicalColour, X)], String)]
l		-> ([(LogicalColour, X)] -> CastleableRooksByLogicalColour)
-> ([(LogicalColour, X)], String)
-> (CastleableRooksByLogicalColour, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> ([(LogicalColour, X)] -> AbscissaeByLogicalColour)
-> [(LogicalColour, X)]
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LogicalColour, X)] -> AbscissaeByLogicalColour
forall k v. Ord k => [(k, v)] -> [(k, [v])]
Data.List.Extra.groupSort) (([(LogicalColour, X)], String)
 -> (CastleableRooksByLogicalColour, String))
-> [([(LogicalColour, X)], String)]
-> [(CastleableRooksByLogicalColour, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` [([(LogicalColour, X)], String)]
l

instance Property.ExtendedPositionDescription.ShowsEPD CastleableRooksByLogicalColour where
	showsEPD :: CastleableRooksByLogicalColour -> ShowS
showsEPD MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }
		| ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([X] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([X] -> Bool)
-> ((LogicalColour, [X]) -> [X]) -> (LogicalColour, [X]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> [X]
forall a b. (a, b) -> b
snd) AbscissaeByLogicalColour
assocs	= ShowS
Property.ExtendedPositionDescription.showsNullField
		| Bool
otherwise			= (Piece -> ShowS -> ShowS) -> ShowS -> [Piece] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
			ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (ShowS -> ShowS -> ShowS)
-> (Piece -> ShowS) -> Piece -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD
		) ShowS
forall a. a -> a
id [
			LogicalColour -> Piece
pieceConstructor LogicalColour
logicalColour |
				LogicalColour
logicalColour			<- [LogicalColour
Attribute.LogicalColour.White, LogicalColour
Attribute.LogicalColour.Black],	-- N.B.: the order is standardised.
				(X
rooksX, LogicalColour -> Piece
pieceConstructor)	<- [(X
Cartesian.Abscissa.xMax, LogicalColour -> Piece
Component.Piece.mkKing), (X
Cartesian.Abscissa.xMin, LogicalColour -> Piece
Component.Piece.mkQueen)],	-- N.B.: the order is defined as King-side (short) before Queen-side (long), which is also alphabetical.
				LogicalColour -> X -> AbscissaeByLogicalColour -> Bool
canCastleWith' LogicalColour
logicalColour X
rooksX AbscissaeByLogicalColour
assocs
		] -- List-comprehension.

instance Property.ForsythEdwards.ReadsFEN CastleableRooksByLogicalColour

instance Property.ForsythEdwards.ShowsFEN CastleableRooksByLogicalColour

-- | Get the list of random numbers required to represent the current castling potential.
instance StateProperty.Hashable.Hashable CastleableRooksByLogicalColour where
	listRandoms :: CastleableRooksByLogicalColour
-> Zobrist positionHash -> [positionHash]
listRandoms MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } Zobrist positionHash
zobrist	= [Maybe positionHash] -> [positionHash]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes [
		LogicalColour -> X -> Zobrist positionHash -> Maybe positionHash
forall positionHash.
LogicalColour -> X -> Zobrist positionHash -> Maybe positionHash
Component.Zobrist.dereferenceRandomByCastleableRooksXByLogicalColour LogicalColour
logicalColour X
x Zobrist positionHash
zobrist |
			LogicalColour
logicalColour	<- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
			X
x		<- [X] -> Maybe [X] -> [X]
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe [] (Maybe [X] -> [X]) -> Maybe [X] -> [X]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs
	 ] -- List-comprehension.

-- | Smart constructor.
fromAssocs :: AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs :: AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs AbscissaeByLogicalColour
assocs
	| [LogicalColour] -> Bool
forall a. Eq a => [a] -> Bool
Data.List.Extra.anySame ([LogicalColour] -> Bool) -> [LogicalColour] -> Bool
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> LogicalColour)
-> AbscissaeByLogicalColour -> [LogicalColour]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst {-logicalColour-} AbscissaeByLogicalColour
assocs	= Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.CastleableRooksByLogicalColour.fromAssocs:\tduplicate logical colours have been defined; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour
assocs String
"."
	| ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([X] -> Bool
forall a. Eq a => [a] -> Bool
Data.List.Extra.anySame ([X] -> Bool)
-> ((LogicalColour, [X]) -> [X]) -> (LogicalColour, [X]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> [X]
forall a b. (a, b) -> b
snd) AbscissaeByLogicalColour
assocs			= Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.CastleableRooksByLogicalColour.fromAssocs:\tduplicate abscissae have been defined; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour
assocs String
"."
	| ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
		(X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
			X -> [X] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [X
Cartesian.Abscissa.xMin, X
Cartesian.Abscissa.xMax]
		) ([X] -> Bool)
-> ((LogicalColour, [X]) -> [X]) -> (LogicalColour, [X]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> [X]
forall a b. (a, b) -> b
snd {-[x]-}
	) AbscissaeByLogicalColour
assocs							= Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
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.State.CastleableRooksByLogicalColour.fromAssocs:\tall abscissae must reference unmoved Rooks; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour
assocs String
"."
	| Bool
otherwise	= AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [X] -> [X]
forall a. Ord a => [a] -> [a]
Data.List.sort) AbscissaeByLogicalColour
assocs

{- |
	* Smart constructor.

	* CAVEAT: doesn't know the move-history, so the wrong answer is possible.
-}
fromBoard :: State.Board.Board -> CastleableRooksByLogicalColour
fromBoard :: Board -> CastleableRooksByLogicalColour
fromBoard Board
board
	| (LogicalColour -> Bool) -> [LogicalColour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
		\LogicalColour
logicalColour -> LogicalColour -> CastleableRooksByLogicalColour -> Bool
hasCastled LogicalColour
logicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour Bool -> Bool -> Bool
&& (Coordinates -> Bool) -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
			Coordinates -> [Coordinates] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Pawn CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
		) [
			X -> X -> Coordinates
Cartesian.Coordinates.mkCoordinates X
x (
				LogicalColour -> X
Cartesian.Ordinate.pawnsFirstRank LogicalColour
logicalColour
			) |
				X
bishopsAbscissa	<- [X]
Cartesian.Abscissa.bishopsFiles,
				X
x		<- X -> [X]
Cartesian.Abscissa.getAdjacents X
bishopsAbscissa
		] -- List-comprehension.
	) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members	= Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.CastleableRooksByLogicalColourFromBoard.fromBoard:\tfor castling to have occurred, a Bishop must have been moved, which can only happen when a blocking Pawn is moved; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (CastleableRooksByLogicalColour, Board) -> ShowS
forall a. Show a => a -> ShowS
shows (CastleableRooksByLogicalColour
castleableRooksByLogicalColour, Board
board) String
"."
	| Bool
otherwise	= CastleableRooksByLogicalColour
castleableRooksByLogicalColour
	where
		coordinatesByRankByLogicalColour :: CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour	= Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour Board
board
		castleableRooksByLogicalColour :: CastleableRooksByLogicalColour
castleableRooksByLogicalColour		= AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, [X]))
-> [LogicalColour] -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (
			\LogicalColour
logicalColour -> (
				LogicalColour
logicalColour,
				[
					Coordinates -> X
Cartesian.Coordinates.getX Coordinates
rooksCoordinates |
						LogicalColour -> CoordinatesByRankByLogicalColour -> Coordinates
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour,
						Coordinates
rooksCoordinates	<- LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Rook CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
						Coordinates
rooksCoordinates Coordinates -> [Coordinates] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LogicalColour -> [Coordinates]
Cartesian.Coordinates.rooksStartingCoordinates LogicalColour
logicalColour
				] -- List-comprehension.
			) -- Pair.
		 ) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

-- | Narrow the type, so the /turn/ can be queried.
type TurnsByLogicalColour	= State.TurnsByLogicalColour.TurnsByLogicalColour Component.Turn.Turn

-- | Constructor.
fromTurnsByLogicalColour :: TurnsByLogicalColour -> CastleableRooksByLogicalColour
fromTurnsByLogicalColour :: TurnsByLogicalColour -> CastleableRooksByLogicalColour
fromTurnsByLogicalColour TurnsByLogicalColour
turnsByLogicalColour	= AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour
 -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> [LogicalColour]
-> AbscissaeByLogicalColour
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
	\LogicalColour
logicalColour -> let
		turns :: [Turn]
turns	= LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
logicalColour TurnsByLogicalColour
turnsByLogicalColour
	in if (Turn -> Bool) -> [Turn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MoveType -> Bool
Attribute.MoveType.isCastle (MoveType -> Bool) -> (Turn -> MoveType) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> MoveType)
-> (Turn -> QualifiedMove) -> Turn -> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove) [Turn]
turns
		then AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id	-- Have Castled.
		else (:) (
			LogicalColour
logicalColour,
			[
				Coordinates -> X
Cartesian.Coordinates.getX Coordinates
coordinates |
					Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Turn] -> Bool
haveMovedFrom (LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour) [Turn]
turns,
					Coordinates
coordinates	<- LogicalColour -> [Coordinates]
Cartesian.Coordinates.rooksStartingCoordinates LogicalColour
logicalColour,
					Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Turn] -> Bool
haveMovedFrom Coordinates
coordinates [Turn]
turns Bool -> Bool -> Bool
|| Coordinates -> [Turn] -> Bool
haveMovedTo Coordinates
coordinates (LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour) TurnsByLogicalColour
turnsByLogicalColour)
			] -- List-comprehension.
		) -- Pair.
 ) [] [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members where
	haveMovedFrom, haveMovedTo :: Cartesian.Coordinates.Coordinates -> [Component.Turn.Turn] -> Bool
	haveMovedFrom :: Coordinates -> [Turn] -> Bool
haveMovedFrom Coordinates
coordinates	= (Turn -> Bool) -> [Turn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Turn -> Bool) -> [Turn] -> Bool)
-> (Turn -> Bool) -> [Turn] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
coordinates) (Coordinates -> Bool) -> (Turn -> Coordinates) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getSource (Move -> Coordinates) -> (Turn -> Move) -> Turn -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove
	haveMovedTo :: Coordinates -> [Turn] -> Bool
haveMovedTo Coordinates
coordinates		= (Turn -> Bool) -> [Turn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Turn -> Bool) -> [Turn] -> Bool)
-> (Turn -> Bool) -> [Turn] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
coordinates) (Coordinates -> Bool) -> (Turn -> Coordinates) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> Coordinates) -> (Turn -> Move) -> Turn -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove

-- | Predicate.
hasCastled :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour -> Bool
hasCastled :: LogicalColour -> CastleableRooksByLogicalColour -> Bool
hasCastled LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour) (LogicalColour -> Bool)
-> ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst) AbscissaeByLogicalColour
assocs

-- | Predicate.
canCastle :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour -> Bool
canCastle :: LogicalColour -> CastleableRooksByLogicalColour -> Bool
canCastle LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= Bool -> ([X] -> Bool) -> Maybe [X] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False {-has castled-} (Bool -> Bool
not (Bool -> Bool) -> ([X] -> Bool) -> [X] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Maybe [X] -> Bool) -> Maybe [X] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs

-- | Infer the @Rook@'s ordinate from the /piece/'s /logical colour/.
inferRooksOrdinate :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y
inferRooksOrdinate :: LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour
	| LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour	= X
Cartesian.Ordinate.yMax
	| Bool
otherwise					= X
Cartesian.Ordinate.yMin

-- | Predicate.
canCastleWith
	:: Attribute.LogicalColour.LogicalColour
	-> Cartesian.Coordinates.Coordinates	-- ^ @Rook@'s coordinates.
	-> CastleableRooksByLogicalColour
	-> Bool
canCastleWith :: LogicalColour
-> Coordinates -> CastleableRooksByLogicalColour -> Bool
canCastleWith LogicalColour
logicalColour Coordinates
rookSource MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= Bool -> ([X] -> Bool) -> Maybe [X] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False {-has castled-} (
	(X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((X -> Bool) -> [X] -> Bool) -> (X -> Bool) -> [X] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
rookSource) (Coordinates -> Bool) -> (X -> Coordinates) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> X -> Coordinates
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour)
 ) (Maybe [X] -> Bool) -> Maybe [X] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs

-- | Find the abscissae of all @Rook@s of the specified /logical colour/, which can still participate in castling.
locateForLogicalColour :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour -> Maybe [Type.Length.X]
{-# INLINE locateForLogicalColour #-}
locateForLogicalColour :: LogicalColour -> CastleableRooksByLogicalColour -> Maybe [X]
locateForLogicalColour LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs

-- | Self-documentation.
type Transformation	= CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour

-- | Relinquish the ability to disambiguate between "have Castled" (& therefore can't subsequently), & "Have lost the option to castle".
unify :: Transformation
unify :: CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
unify MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour
 -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> [LogicalColour]
-> AbscissaeByLogicalColour
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
	\LogicalColour
logicalColour AbscissaeByLogicalColour
assocs'	-> (
		if ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour) (LogicalColour -> Bool)
-> ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst) AbscissaeByLogicalColour
assocs
			then AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
			else AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
				(LogicalColour
logicalColour, []) (LogicalColour, [X])
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> [a] -> [a]
:
			)
	) AbscissaeByLogicalColour
assocs'
 ) AbscissaeByLogicalColour
assocs [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

-- | Update with the latest /turn/.
takeTurn
	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side who took the specified turn.
	-> Component.Turn.Turn
	-> Transformation
takeTurn :: LogicalColour
-> Turn
-> CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
takeTurn LogicalColour
logicalColour Turn
turn MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }	= AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (
	case LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs of
		Just []	-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id	-- This is a terminal state.
		Just [X]
rooksXs
			| MoveType -> Bool
Attribute.MoveType.isCastle (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove	-> LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
castle LogicalColour
logicalColour
			| Turn -> Rank
Component.Turn.getRank Turn
turn Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.King {-but not castling-}		-> LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
relinquishCastlingRights LogicalColour
logicalColour
			| let source :: Coordinates
source	= Move -> Coordinates
Component.Move.getSource Move
move
			, (X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
				(Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
source) (Coordinates -> Bool) -> (X -> Coordinates) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> X -> Coordinates
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour)
			) [X]
rooksXs										-> LogicalColour
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
removeX LogicalColour
logicalColour (X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ Coordinates -> X
Cartesian.Coordinates.getX Coordinates
source
			| Bool
otherwise										-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
		Maybe [X]
_	-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id	-- This is a terminal state.
 ) (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ (
	let
		opponentsLogicalColour :: LogicalColour
opponentsLogicalColour	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
	in case LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
opponentsLogicalColour AbscissaeByLogicalColour
assocs of
		Just [X]
rooksXs
			| let destination :: Coordinates
destination	= Move -> Coordinates
Component.Move.getDestination Move
move
			, (X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
				(Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
destination) (Coordinates -> Bool) -> (X -> Coordinates) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> X -> Coordinates
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> X
inferRooksOrdinate LogicalColour
opponentsLogicalColour)
			) [X]
rooksXs	-> LogicalColour
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
removeX LogicalColour
opponentsLogicalColour (X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ Coordinates -> X
Cartesian.Coordinates.getX Coordinates
destination
			| Bool
otherwise	-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
		Maybe [X]
_			-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id	-- This is a terminal state.
 ) AbscissaeByLogicalColour
assocs where
	qualifiedMove :: QualifiedMove
qualifiedMove	= Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
	move :: Move
move		= QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove

{- |
	* Determines whether two /position/s can't converge on each other.

	* N.B.: in this function, the two /positions/ are considered to be peers; nothing is assumed regarding which must do the convergence, perhaps both.

	* From the initial board, one may converge onto any other /position/, but any of a set of irreversible changes may compromise this;
		the total number of /piece/s & specifically @Pawn@s, of each /logical colour/, can't increase;
		@Pawn@s can only advance;
		the difference in the /rank/s of all /piece/s of each /logical colour/, which can only be reduced through promotion of a @Pawn@;
		castling can't be undone.
	This function only assesses this final change.

	* CAVEAT: since the potential of one /position/ to converge on another, depends on a wider set of criteria,
	this function can only be definitive regarding when convergence is impossible, rather than when is possible.

	* CAVEAT: this function depends on one side having lost the right to castle, when the other side already has; this is quite rare.
-}
cantConverge
	:: CastleableRooksByLogicalColour
	-> CastleableRooksByLogicalColour
	-> Bool
cantConverge :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
cantConverge CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour'	= (LogicalColour -> Bool) -> [LogicalColour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
	\LogicalColour
logicalColour -> case ((CastleableRooksByLogicalColour -> Maybe [X])
-> CastleableRooksByLogicalColour -> Maybe [X]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour
castleableRooksByLogicalColour) ((CastleableRooksByLogicalColour -> Maybe [X]) -> Maybe [X])
-> ((CastleableRooksByLogicalColour -> Maybe [X]) -> Maybe [X])
-> (CastleableRooksByLogicalColour -> Maybe [X])
-> (Maybe [X], Maybe [X])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((CastleableRooksByLogicalColour -> Maybe [X])
-> CastleableRooksByLogicalColour -> Maybe [X]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour
castleableRooksByLogicalColour') ((CastleableRooksByLogicalColour -> Maybe [X])
 -> (Maybe [X], Maybe [X]))
-> (CastleableRooksByLogicalColour -> Maybe [X])
-> (Maybe [X], Maybe [X])
forall a b. (a -> b) -> a -> b
$ LogicalColour -> CastleableRooksByLogicalColour -> Maybe [X]
locateForLogicalColour LogicalColour
logicalColour of
		(Just [], Maybe [X]
Nothing)	-> Bool
True
		(Maybe [X]
Nothing, Just [])	-> Bool
True
		(Maybe [X], Maybe [X])
_			-> Bool
False
 ) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

-- | Generate the additional random-numbers required to correct the hash resulting from a change to the castleable @Rook@s.
listIncrementalRandoms
	:: CastleableRooksByLogicalColour	-- ^ The old value.
	-> CastleableRooksByLogicalColour	-- ^ The new value.
	-> Component.Zobrist.Zobrist random
	-> [random]
listIncrementalRandoms :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Zobrist random -> [random]
listIncrementalRandoms CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour' Zobrist random
zobrist	= [
	random
random |
		CastleableRooksByLogicalColour
hashable	<- [CastleableRooksByLogicalColour
castleableRooksByLogicalColour, CastleableRooksByLogicalColour
castleableRooksByLogicalColour'],
		random
random		<- CastleableRooksByLogicalColour -> Zobrist random -> [random]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
StateProperty.Hashable.listRandoms CastleableRooksByLogicalColour
hashable Zobrist random
zobrist
 ] -- List-comprehension.