{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-
	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@]	Defines the data-type which represents any chess-piece.
-}

module BishBosh.Component.Piece(
-- * Types
-- ** Type-synonyms
	NPieces,
	ByPiece,
	LocatedPiece,
-- ** Data-types
	Piece(
--		MkPiece,
		getLogicalColour,
		getRank
	),
-- * Constants
--	tag,
	nPiecesPerSide,
	range,
--	attackVectorsByPiece,
	attackDirectionsByPiece,
--	attackDestinationsByCoordinatesByRankByLogicalColour,
-- * Functions
	findAttackDestinations,
--	findAttackDestinationsInt,
-- ** Mutators
	promote,
-- ** Constructors
	mkBishop,
	mkKing,
	mkKnight,
	mkPawn,
	mkPiece,
	mkQueen,
	mkRook,
	listArrayByPiece,
-- ** Predicates
	canAttackAlong,
	canMoveBetween,
	isBlack,
	isFriend,
--	isPeer,
	isPawn,
	isKnight,
--	isBishop,
--	isRook,
--	isQueen,
	isKing,
	isPawnPromotion
) where

import			Control.Arrow((&&&), (***))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.Direction			as Attribute.Direction
import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour
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.Cartesian.Vector			as Cartesian.Vector
import qualified	BishBosh.Property.ExtendedPositionDescription	as Property.ExtendedPositionDescription
import qualified	BishBosh.Property.ForsythEdwards		as Property.ForsythEdwards
import qualified	BishBosh.Property.Opposable			as Property.Opposable
import qualified	BishBosh.Types					as T
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Char
import qualified	Data.List.Extra
import qualified	Data.Map
import qualified	Data.Maybe
import qualified	Text.XML.HXT.Arrow.Pickle			as HXT
import qualified	Text.XML.HXT.Arrow.Pickle.Schema

-- | Used to qualify XML.
tag :: String
tag :: String
tag	= String
"piece"

-- | A number of /piece/s.
type NPieces	= Int	-- N.B.: 'Data.Int.Int8' saves neither time nor space.

-- | The initial number of pieces per side in a standard opening position; some of which are duplicates.
nPiecesPerSide :: NPieces
nPiecesPerSide :: NPieces
nPiecesPerSide	= NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces
2 {-rows-}

-- | A Chess-piece has a /logical colour/ & a /rank/.
data Piece	= MkPiece {
	Piece -> LogicalColour
getLogicalColour	:: Attribute.LogicalColour.LogicalColour,
	Piece -> Rank
getRank			:: Attribute.Rank.Rank
} deriving (Piece
Piece -> Piece -> Bounded Piece
forall a. a -> a -> Bounded a
maxBound :: Piece
$cmaxBound :: Piece
minBound :: Piece
$cminBound :: Piece
Bounded, Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: Piece -> Piece -> Bool
Eq, Eq Piece
Eq Piece
-> (Piece -> Piece -> Ordering)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Piece)
-> (Piece -> Piece -> Piece)
-> Ord Piece
Piece -> Piece -> Bool
Piece -> Piece -> Ordering
Piece -> Piece -> Piece
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 :: Piece -> Piece -> Piece
$cmin :: Piece -> Piece -> Piece
max :: Piece -> Piece -> Piece
$cmax :: Piece -> Piece -> Piece
>= :: Piece -> Piece -> Bool
$c>= :: Piece -> Piece -> Bool
> :: Piece -> Piece -> Bool
$c> :: Piece -> Piece -> Bool
<= :: Piece -> Piece -> Bool
$c<= :: Piece -> Piece -> Bool
< :: Piece -> Piece -> Bool
$c< :: Piece -> Piece -> Bool
compare :: Piece -> Piece -> Ordering
$ccompare :: Piece -> Piece -> Ordering
$cp1Ord :: Eq Piece
Ord)

instance Control.DeepSeq.NFData Piece where
	rnf :: Piece -> ()
rnf MkPiece {
		getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
		getRank :: Piece -> Rank
getRank			= Rank
rank
	} = (LogicalColour, Rank) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (LogicalColour
logicalColour, Rank
rank)

instance Data.Array.IArray.Ix Piece where
	range :: (Piece, Piece) -> [Piece]
range (Piece
lower, Piece
upper)		= Bool -> [Piece] -> [Piece]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
lower Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Piece
upper Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
maxBound) [Piece]
range
	inRange :: (Piece, Piece) -> Piece -> Bool
inRange (Piece
lower, Piece
upper) Piece
piece	= Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
piece Piece -> Piece -> Bool
forall a. Ord a => a -> a -> Bool
>= Piece
lower Bool -> Bool -> Bool
&& Piece
piece Piece -> Piece -> Bool
forall a. Ord a => a -> a -> Bool
<= Piece
upper) Bool
True
	index :: (Piece, Piece) -> Piece -> NPieces
index (Piece
lower, Piece
upper) MkPiece {
		getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
		getRank :: Piece -> Rank
getRank			= Rank
rank
	} = Bool -> NPieces -> NPieces
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
lower Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Piece
upper Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
maxBound) (NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour -> NPieces
forall a. Enum a => a -> NPieces
fromEnum LogicalColour
logicalColour NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces
Attribute.Rank.nDistinctRanks NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ Rank -> NPieces
forall a. Enum a => a -> NPieces
fromEnum Rank
rank

instance Read Piece where
	readsPrec :: NPieces -> ReadS Piece
readsPrec NPieces
_	= ReadS Piece
forall a. ReadsFEN a => ReadS a
Property.ForsythEdwards.readsFEN

instance Show Piece where
	showsPrec :: NPieces -> Piece -> ShowS
showsPrec NPieces
_	= Piece -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN

instance Property.ExtendedPositionDescription.ReadsEPD Piece where
	readsEPD :: ReadS Piece
readsEPD String
s	= case ShowS
Data.List.Extra.trimStart String
s of
		Char
c : String
remainder	-> (
			LogicalColour -> Rank -> Piece
MkPiece (
				if Char -> Bool
Data.Char.isUpper Char
c
					then LogicalColour
Attribute.LogicalColour.White
					else LogicalColour
Attribute.LogicalColour.Black
			) (Rank -> Piece) -> ShowS -> (Rank, String) -> (Piece, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> ShowS
forall a b. a -> b -> a
const String
remainder
		 ) ((Rank, String) -> (Piece, String))
-> [(Rank, String)] -> [(Piece, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS Rank
forall a. Read a => ReadS a
reads [Char
c]
		String
_		-> []	-- No parse.

instance Property.ExtendedPositionDescription.ShowsEPD Piece where
	showsEPD :: Piece -> ShowS
showsEPD piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank }	= String -> ShowS
showString (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (
		if Piece -> Bool
isBlack Piece
piece
			then Char -> Char
Data.Char.toLower	-- Only required for independence from the specific implementation of Read for Rank.
			else Char -> Char
Data.Char.toUpper
	 ) (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Rank -> String
forall a. Show a => a -> String
show Rank
rank

instance Property.ForsythEdwards.ReadsFEN Piece

instance Property.ForsythEdwards.ShowsFEN Piece

instance HXT.XmlPickler Piece where
	xpickle :: PU Piece
xpickle	= (String -> Piece, Piece -> String) -> PU String -> PU Piece
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> Piece
forall a. Read a => String -> a
read, Piece -> String
forall a. Show a => a -> String
show) (PU String -> PU Piece)
-> ([String] -> PU String) -> [String] -> PU Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU Piece) -> [String] -> PU Piece
forall a b. (a -> b) -> a -> b
$ (Piece -> String) -> [Piece] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Piece -> String
forall a. Show a => a -> String
show [Piece]
range

instance Property.Opposable.Opposable Piece where
	getOpposite :: Piece -> Piece
getOpposite piece :: Piece
piece@MkPiece {
		getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour
	} = Piece
piece {
		getLogicalColour :: LogicalColour
getLogicalColour	= LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
	}

-- | Constructor.
mkPiece :: Attribute.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> Piece
mkPiece :: LogicalColour -> Rank -> Piece
mkPiece	= LogicalColour -> Rank -> Piece
MkPiece

-- | Constructor.
mkPawn :: Attribute.LogicalColour.LogicalColour -> Piece
mkPawn :: LogicalColour -> Piece
mkPawn		= (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Pawn)

-- | Constructor.
mkRook :: Attribute.LogicalColour.LogicalColour -> Piece
mkRook :: LogicalColour -> Piece
mkRook		= (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Rook)

-- | Constructor.
mkKnight :: Attribute.LogicalColour.LogicalColour -> Piece
mkKnight :: LogicalColour -> Piece
mkKnight	= (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Knight)

-- | Constructor.
mkBishop:: Attribute.LogicalColour.LogicalColour -> Piece
mkBishop :: LogicalColour -> Piece
mkBishop	= (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Bishop)

-- | Constructor.
mkQueen :: Attribute.LogicalColour.LogicalColour -> Piece
mkQueen :: LogicalColour -> Piece
mkQueen		= (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Queen)

-- | Constructor.
mkKing :: Attribute.LogicalColour.LogicalColour -> Piece
mkKing :: LogicalColour -> Piece
mkKing		= (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.King)

-- | The constant ascending range of /piece/s.
range :: [Piece]
range :: [Piece]
range	= [
	MkPiece :: LogicalColour -> Rank -> Piece
MkPiece {
		getLogicalColour :: LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
		getRank :: Rank
getRank			= Rank
rank
	} |
		LogicalColour
logicalColour	<- [LogicalColour]
Attribute.LogicalColour.range,
		Rank
rank		<- [Rank]
Attribute.Rank.range
 ] -- List-comprehension.

{- |
	* Changes the /rank/ of the specified /piece/, leaving the /logical colour/ unchanged.

	* CAVEAT: only legal if the /rank/ was a @Pawn@, & becomes neither a @Pawn@ nor a @King@.
-}
promote :: Attribute.Rank.Rank -> Piece -> Piece
promote :: Rank -> Piece -> Piece
promote Rank
newRank Piece
piece	= Piece
piece { getRank :: Rank
getRank = Rank
newRank }

{- |
	* The constant /vector/s over which the specified type of /piece/ can attack.

	* CAVEAT: only defined for 'Attribute.Rank.fixedAttackRange'.

	* CAVEAT: it doesn't identify @Pawn@-advances, since these aren't attacks.
-}
attackVectorsByPiece :: (Num distance, Ord distance) => Data.Map.Map Piece [Cartesian.Vector.Vector distance]
attackVectorsByPiece :: Map Piece [Vector distance]
attackVectorsByPiece	= [(Piece, [Vector distance])] -> Map Piece [Vector distance]
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
	(Piece
piece, [Vector distance]
vectors) |
		(Piece
piece, Just [Vector distance]
vectors) <- (Piece -> (Piece, Maybe [Vector distance]))
-> [Piece] -> [(Piece, Maybe [Vector distance])]
forall a b. (a -> b) -> [a] -> [b]
map (
			Piece -> Piece
forall a. a -> a
id (Piece -> Piece)
-> (Piece -> Maybe [Vector distance])
-> Piece
-> (Piece, Maybe [Vector distance])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
				\Piece
piece -> case Piece -> Rank
getRank Piece
piece of
					Rank
Attribute.Rank.Pawn	-> [Vector distance] -> Maybe [Vector distance]
forall a. a -> Maybe a
Just ([Vector distance] -> Maybe [Vector distance])
-> (LogicalColour -> [Vector distance])
-> LogicalColour
-> Maybe [Vector distance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> [Vector distance]
forall distance. Num distance => LogicalColour -> [Vector distance]
Cartesian.Vector.attackVectorsForPawn (LogicalColour -> Maybe [Vector distance])
-> LogicalColour -> Maybe [Vector distance]
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
getLogicalColour Piece
piece
					Rank
Attribute.Rank.Knight	-> [Vector distance] -> Maybe [Vector distance]
forall a. a -> Maybe a
Just [Vector distance]
forall distance. Num distance => [Vector distance]
Cartesian.Vector.attackVectorsForKnight
					Rank
Attribute.Rank.King	-> [Vector distance] -> Maybe [Vector distance]
forall a. a -> Maybe a
Just [Vector distance]
forall distance. (Eq distance, Num distance) => [Vector distance]
Cartesian.Vector.attackVectorsForKing
					Rank
_			-> Maybe [Vector distance]
forall a. Maybe a
Nothing	-- These ranks attack over any distance.
			)
		) [Piece]
range
 ] -- List-comprehension.

{- |
	* The destinations available to those pieces with attack-vectors; @Pawn@, @Knight@, @King@.

	* CAVEAT: the destinations for a @Pawn@, are only those corresponding to diagonal attacks.

	* CAVEAT: this function has no knowledge of the /board/, & therefore of the position of any other piece.
-}
attackDestinationsByCoordinatesByRankByLogicalColour :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Cartesian.Coordinates.ByCoordinates x y (Data.Map.Map Piece [Cartesian.Coordinates.Coordinates x y])
{-# SPECIALISE attackDestinationsByCoordinatesByRankByLogicalColour :: Cartesian.Coordinates.ByCoordinates T.X T.Y (Data.Map.Map Piece [Cartesian.Coordinates.Coordinates T.X T.Y]) #-}	-- To promote memoisation.
attackDestinationsByCoordinatesByRankByLogicalColour :: ByCoordinates x y (Map Piece [Coordinates x y])
attackDestinationsByCoordinatesByRankByLogicalColour	= [Map Piece [Coordinates x y]]
-> ByCoordinates x y (Map Piece [Coordinates x y])
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
Cartesian.Coordinates.listArrayByCoordinates ([Map Piece [Coordinates x y]]
 -> ByCoordinates x y (Map Piece [Coordinates x y]))
-> [Map Piece [Coordinates x y]]
-> ByCoordinates x y (Map Piece [Coordinates x y])
forall a b. (a -> b) -> a -> b
$ (Coordinates x y -> Map Piece [Coordinates x y])
-> [Coordinates x y] -> [Map Piece [Coordinates x y]]
forall a b. (a -> b) -> [a] -> [b]
map (
	\Coordinates x y
source -> [(Piece, [Coordinates x y])] -> Map Piece [Coordinates x y]
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [
		(
			Piece
piece,
			(Vector NPieces -> Maybe (Coordinates x y))
-> [Vector NPieces] -> [Coordinates x y]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (Coordinates x y -> Vector NPieces -> Maybe (Coordinates x y)
forall x y distance.
(Enum x, Enum y, Integral distance, Ord x, Ord y) =>
Coordinates x y -> Vector distance -> Maybe (Coordinates x y)
Cartesian.Vector.maybeTranslate Coordinates x y
source) (Map Piece [Vector NPieces]
forall distance.
(Num distance, Ord distance) =>
Map Piece [Vector distance]
attackVectorsByPiece Map Piece [Vector NPieces] -> Piece -> [Vector NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Piece
piece :: [Cartesian.Vector.VectorInt])
		) |
			LogicalColour
logicalColour	<- [LogicalColour]
Attribute.LogicalColour.range,
			Rank
rank		<- [Rank]
Attribute.Rank.fixedAttackRange,
			let piece :: Piece
piece	= LogicalColour -> Rank -> Piece
mkPiece LogicalColour
logicalColour Rank
rank
	] -- List-comprehension.
 ) [Coordinates x y]
forall x y. (Enum x, Enum y) => [Coordinates x y]
Cartesian.Coordinates.range

-- | Calls 'attackVectorsByPiece' to find the destinations which the specified /piece/ can attack from the specified position.
findAttackDestinations :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> Cartesian.Coordinates.Coordinates x y	-- ^ The source from which the attack originates.
	-> Piece
	-> [Cartesian.Coordinates.Coordinates x y]	-- ^ The destinations which can be attacked.
{-# NOINLINE findAttackDestinations #-}	-- Ensure the rewrite-rule triggers.
{-# RULES "findAttackDestinations/Int" findAttackDestinations = findAttackDestinationsInt #-}	-- CAVEAT: the call-stack leading to this function must be specialised to ensure this triggers.
findAttackDestinations :: Coordinates x y -> Piece -> [Coordinates x y]
findAttackDestinations Coordinates x y
source Piece
piece	= (Vector NPieces -> Maybe (Coordinates x y))
-> [Vector NPieces] -> [Coordinates x y]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (Coordinates x y -> Vector NPieces -> Maybe (Coordinates x y)
forall x y distance.
(Enum x, Enum y, Integral distance, Ord x, Ord y) =>
Coordinates x y -> Vector distance -> Maybe (Coordinates x y)
Cartesian.Vector.maybeTranslate Coordinates x y
source) (Map Piece [Vector NPieces]
forall distance.
(Num distance, Ord distance) =>
Map Piece [Vector distance]
attackVectorsByPiece Map Piece [Vector NPieces] -> Piece -> [Vector NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Piece
piece :: [Cartesian.Vector.VectorInt])

-- | A specialisation of 'findAttackDestinations', more efficiently implemented by calling 'attackDestinationsByCoordinatesByRankByLogicalColour'.
findAttackDestinationsInt :: Cartesian.Coordinates.Coordinates T.X T.Y -> Piece -> [Cartesian.Coordinates.Coordinates T.X T.Y]
findAttackDestinationsInt :: Coordinates NPieces NPieces
-> Piece -> [Coordinates NPieces NPieces]
findAttackDestinationsInt Coordinates NPieces NPieces
coordinates Piece
piece	= ByCoordinates
  NPieces NPieces (Map Piece [Coordinates NPieces NPieces])
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
ByCoordinates x y (Map Piece [Coordinates x y])
attackDestinationsByCoordinatesByRankByLogicalColour ByCoordinates
  NPieces NPieces (Map Piece [Coordinates NPieces NPieces])
-> Coordinates NPieces NPieces
-> Map Piece [Coordinates NPieces NPieces]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates NPieces NPieces
coordinates Map Piece [Coordinates NPieces NPieces]
-> Piece -> [Coordinates NPieces NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Piece
piece

{- |
	* Find the constant directions of the straight lines along which each type of /piece/ can attack.

	* CAVEAT: not defined for a @Knight@.
-}
attackDirectionsByPiece :: Data.Map.Map Piece [Attribute.Direction.Direction]
attackDirectionsByPiece :: Map Piece [Direction]
attackDirectionsByPiece	= [(Piece, [Direction])] -> Map Piece [Direction]
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
	(
		Piece
piece,
		case Piece -> Rank
getRank Piece
piece of
			Rank
Attribute.Rank.Pawn	-> LogicalColour -> [Direction]
Attribute.Direction.attackDirectionsForPawn (LogicalColour -> [Direction]) -> LogicalColour -> [Direction]
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
getLogicalColour Piece
piece
			Rank
Attribute.Rank.Rook	-> [Direction]
Attribute.Direction.parallels
			Rank
Attribute.Rank.Bishop	-> [Direction]
Attribute.Direction.diagonals
			Rank
_ {-royalty-}		-> [Direction]
Attribute.Direction.range
	) |
		Piece
piece	<- [Piece]
range,
		Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Piece -> Bool
isKnight Piece
piece	-- The moves of which have no defined direction.
 ] -- List-comprehension.

{- |
	* Whether a /piece/ at the specified /coordinates/ could attack the target at the specified /coordinates/.

	* N.B.: doesn't require that the specified /piece/ actually exists at the target-location, nor that the victim's /logical colour/ is opposite from the attacker's.

	* N.B.: can't detect any blocking /piece/s which might invalidate the attack.

	* CAVEAT: it won't confirm the ability of a @Pawn@ to advance, since that doesn't constitute an attack.
-}
canAttackAlong
	:: (Enum x, Enum y)
	=> Cartesian.Coordinates.Coordinates x y	-- ^ Source (attacker's location).
	-> Cartesian.Coordinates.Coordinates x y	-- ^ Destination (victim's location).
	-> Piece					-- ^ Attacker.
	-> Bool
canAttackAlong :: Coordinates x y -> Coordinates x y -> Piece -> Bool
canAttackAlong Coordinates x y
source Coordinates x y
destination piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank }	= (
	case Rank
rank of
		Rank
Attribute.Rank.Pawn	-> LogicalColour -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
LogicalColour -> Vector distance -> Bool
Cartesian.Vector.isPawnAttack (LogicalColour -> Vector NPieces -> Bool)
-> LogicalColour -> Vector NPieces -> Bool
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
getLogicalColour Piece
piece
		Rank
Attribute.Rank.Knight	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isKnightsMove
		Rank
Attribute.Rank.Bishop	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isDiagonal
		Rank
Attribute.Rank.Rook	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isParallel
		Rank
Attribute.Rank.Queen	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isStraight
		Rank
Attribute.Rank.King	-> Vector NPieces -> Bool
forall distance.
(Num distance, Ord distance) =>
Vector distance -> Bool
Cartesian.Vector.isKingsMove
 ) (
	Coordinates x y -> Coordinates x y -> Vector NPieces
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
source Coordinates x y
destination	:: Cartesian.Vector.VectorInt
 )

{- |
	* Whether the specified /piece/ can move between the specified /coordinates/.

	* N.B.: can't detect any blocking pieces.
-}
canMoveBetween :: (
	Enum	x,
	Enum	y,
	Eq	y
 )
	=> Cartesian.Coordinates.Coordinates x y	-- ^ Source.
	-> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.
	-> Piece
	-> Bool
{-# SPECIALISE canMoveBetween :: Cartesian.Coordinates.Coordinates T.X T.Y -> Cartesian.Coordinates.Coordinates T.X T.Y -> Piece -> Bool #-}
canMoveBetween :: Coordinates x y -> Coordinates x y -> Piece -> Bool
canMoveBetween Coordinates x y
source Coordinates x y
destination piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank }	= (
	case Rank
rank of
		Rank
Attribute.Rank.Pawn	-> \Vector NPieces
distance -> let
			logicalColour :: LogicalColour
logicalColour	= Piece -> LogicalColour
getLogicalColour Piece
piece
		 in LogicalColour -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
LogicalColour -> Vector distance -> Bool
Cartesian.Vector.isPawnAttack LogicalColour
logicalColour Vector NPieces
distance Bool -> Bool -> Bool
|| Vector NPieces -> NPieces
forall distance. Vector distance -> distance
Cartesian.Vector.getXDistance Vector NPieces
distance NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0 Bool -> Bool -> Bool
&& (
			let
				y' :: NPieces
y'	= (
					if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
						then NPieces -> NPieces
forall a. Num a => a -> a
negate
						else NPieces -> NPieces
forall a. a -> a
id
				 ) (NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ Vector NPieces -> NPieces
forall distance. Vector distance -> distance
Cartesian.Vector.getYDistance Vector NPieces
distance
			in NPieces
y' NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
1 Bool -> Bool -> Bool
|| LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
logicalColour Coordinates x y
source Bool -> Bool -> Bool
&& NPieces
y' NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
2
		 )
		Rank
Attribute.Rank.Knight	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isKnightsMove
		Rank
Attribute.Rank.Bishop	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isDiagonal
		Rank
Attribute.Rank.Rook	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isParallel
		Rank
Attribute.Rank.Queen	-> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isStraight
		Rank
Attribute.Rank.King	-> Vector NPieces -> Bool
forall distance.
(Num distance, Ord distance) =>
Vector distance -> Bool
Cartesian.Vector.isKingsMove
 ) (
	Coordinates x y -> Coordinates x y -> Vector NPieces
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
source Coordinates x y
destination	:: Cartesian.Vector.VectorInt
 )

-- | Whether a move qualifies for @Pawn@-promotion.
isPawnPromotion
	:: (Enum y, Eq y)
	=> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.
	-> Piece
	-> Bool
isPawnPromotion :: Coordinates x y -> Piece -> Bool
isPawnPromotion Coordinates x y
destination MkPiece {
	getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
	getRank :: Piece -> Rank
getRank			= Rank
Attribute.Rank.Pawn
}			= LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.lastRank LogicalColour
logicalColour y -> y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY Coordinates x y
destination
isPawnPromotion Coordinates x y
_ Piece
_	= Bool
False

-- | Whether the specified /piece/ is @Black@.
{-# INLINE isBlack #-}
isBlack :: Piece -> Bool
isBlack :: Piece -> Bool
isBlack MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
Attribute.LogicalColour.Black }	= Bool
True
isBlack Piece
_								= Bool
False

-- | Whether the specified /piece/s have the same /logical colour/.
{-# INLINE isFriend #-}
isFriend :: Piece -> Piece -> Bool
isFriend :: Piece -> Piece -> Bool
isFriend MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour } MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour' }	= LogicalColour
logicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour'

-- | Whether the specified /piece/s have the same /rank/.
isPeer :: Piece -> Piece -> Bool
isPeer :: Piece -> Piece -> Bool
isPeer MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank' }	= Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
rank'

-- | Whether the specified /piece/ is a @Pawn@.
{-# INLINE isPawn #-}
isPawn :: Piece -> Bool
isPawn :: Piece -> Bool
isPawn MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Pawn }	= Bool
True
isPawn Piece
_						= Bool
False

-- | Whether the specified /piece/ is a @Knight@.
{-# INLINE isKnight #-}
isKnight :: Piece -> Bool
isKnight :: Piece -> Bool
isKnight MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Knight }	= Bool
True
isKnight Piece
_						= Bool
False

-- | Whether the specified /piece/ is a @Bishop@.
isBishop :: Piece -> Bool
isBishop :: Piece -> Bool
isBishop MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Bishop }	= Bool
True
isBishop Piece
_						= Bool
False

-- | Whether the specified /piece/ is a @Rook@.
isRook :: Piece -> Bool
isRook :: Piece -> Bool
isRook MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Rook }	= Bool
True
isRook Piece
_						= Bool
False

-- | Whether the specified /piece/ is a @Queen@.
isQueen :: Piece -> Bool
isQueen :: Piece -> Bool
isQueen MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Queen }	= Bool
True
isQueen Piece
_						= Bool
False

-- | Whether the specified /piece/ is a @King@.
{-# INLINE isKing #-}
isKing :: Piece -> Bool
isKing :: Piece -> Bool
isKing MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.King }	= Bool
True
isKing Piece
_						= Bool
False

-- | A boxed array indexed by /piece/, of unspecified elements.
type ByPiece	= Data.Array.IArray.Array {-Boxed-} Piece

-- | Array-constructor.
listArrayByPiece :: Data.Array.IArray.IArray a e => [e] -> a Piece e
listArrayByPiece :: [e] -> a Piece e
listArrayByPiece	= (Piece, Piece) -> [e] -> a Piece e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Piece
forall a. Bounded a => a
minBound, Piece
forall a. Bounded a => a
maxBound)

-- | Self-documentation.
type LocatedPiece x y	= (Cartesian.Coordinates.Coordinates x y, Piece)