{-# LANGUAGE LambdaCase #-}
{-
	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
--	ByRankByLogicalColour,
--	AttackDestinationsByCoordinatesByRankByLogicalColour,
	ArrayByPiece,
	LocatedPiece,
-- ** Data-types
	Piece(
--		MkPiece,
		getLogicalColour,
		getRank
	),
-- * Constants
--	tag,
	range,
	nPiecesPerSide,
	epdCharacterSet,
--	attackVectorsByRankByLogicalColour,
--	attackDirectionsByRankByLogicalColour,
--	attackDestinationsByCoordinatesByRankByLogicalColour,
-- * Functions
--	findAttackDestinations',
	findAttackDestinations,
	showPieces,
-- ** Accessors
	getAttackDirections,
-- ** Mutators
	promote,
-- ** Constructors
--	mkByRankByLogicalColour,
	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.Rank				as Attribute.Rank
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.Colour.LogicalColour			as Colour.LogicalColour
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Direction.Direction			as Direction.Direction
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.Orientated			as Property.Orientated
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Char
import qualified	Data.Foldable
import qualified	Data.List.Extra
import qualified	Data.Map					as 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"

-- | The constant number of pieces per side at the conventional opening position; some of which are duplicates.
nPiecesPerSide :: Type.Count.NPieces
nPiecesPerSide :: NPieces
nPiecesPerSide	= (NPieces -> NPieces -> NPieces)
-> NPieces -> Array Rank NPieces -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
(+) NPieces
0 Array Rank NPieces
Attribute.Rank.initialAllocationByRankPerSide

-- | A Chess-piece has a /logical colour/ & a /rank/.
data Piece	= MkPiece {
	Piece -> LogicalColour
getLogicalColour	:: Colour.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 -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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

-- | The constant set of permissible characters in an EPD.
epdCharacterSet	:: Property.ExtendedPositionDescription.EPD
epdCharacterSet :: String
epdCharacterSet	= (Piece -> String) -> [Piece] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece -> String
forall a. ShowsEPD a => a -> String
Property.ExtendedPositionDescription.showEPD [Piece]
range

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
Colour.LogicalColour.White
					else LogicalColour
Colour.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
	}

-- | 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]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
		Rank
rank		<- [Rank]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
 ] -- List-comprehension.

-- | Returns a constant string containing all possible pieces.
showPieces :: String
showPieces :: String
showPieces	= (Piece -> String) -> [Piece] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece -> String
forall a. Show a => a -> String
show [Piece]
range

instance Property.FixedMembership.FixedMembership Piece where
	members :: [Piece]
members	= [Piece]
range

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

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

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

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

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

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

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

-- | Changes the specified /piece/ to the specified /rank/ leaving its /logical colour/ unchanged.
promote :: Attribute.Rank.Rank -> Piece -> Piece
promote :: Rank -> Piece -> Piece
promote Rank
newRank Piece
piece
	| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Piece -> Bool
isPawn Piece
piece					= Exception -> Piece
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Piece) -> (String -> Exception) -> String -> Piece
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.Component.Piece.promote:\tcan't promote a " (String -> Piece) -> String -> Piece
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
piece String
"."
	| Rank
newRank Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rank]
Attribute.Rank.promotionProspects	= Exception -> Piece
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Piece) -> (String -> Exception) -> String -> Piece
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.Component.Piece.promote:\tcan't promote to a " (String -> Piece) -> String -> Piece
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
newRank String
"."
	| Bool
otherwise						= Piece
piece { getRank :: Rank
getRank = Rank
newRank }

-- | The structure of a container of arbitrary data, indexed by /logicalColour/ & some /rank/s.
type ByRankByLogicalColour element	= Colour.LogicalColour.ArrayByLogicalColour (Map.Map Attribute.Rank.Rank element)

-- | Constructor of a certain shape of container, but with arbitrary contents.
mkByRankByLogicalColour
	:: [Attribute.Rank.Rank]
	-> (Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element)
	-> ByRankByLogicalColour element
mkByRankByLogicalColour :: [Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
ranks LogicalColour -> Rank -> element
mkElement	= [Map Rank element] -> ByRankByLogicalColour element
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([Map Rank element] -> ByRankByLogicalColour element)
-> [Map Rank element] -> ByRankByLogicalColour element
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> Map Rank element)
-> [LogicalColour] -> [Map Rank element]
forall a b. (a -> b) -> [a] -> [b]
map (
	\LogicalColour
logicalColour	-> [(Rank, element)] -> Map Rank element
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Rank, element)] -> Map Rank element)
-> [(Rank, element)] -> Map Rank element
forall a b. (a -> b) -> a -> b
$ (Rank -> (Rank, element)) -> [Rank] -> [(Rank, element)]
forall a b. (a -> b) -> [a] -> [b]
map (Rank -> Rank
forall a. a -> a
id (Rank -> Rank) -> (Rank -> element) -> Rank -> (Rank, element)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Rank -> element
mkElement LogicalColour
logicalColour) [Rank]
ranks
 ) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

{- |
	* 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.
-}
attackVectorsByRankByLogicalColour :: ByRankByLogicalColour [Cartesian.Vector.Vector]
attackVectorsByRankByLogicalColour :: ByRankByLogicalColour [Vector]
attackVectorsByRankByLogicalColour	= [Rank]
-> (LogicalColour -> Rank -> [Vector])
-> ByRankByLogicalColour [Vector]
forall element.
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.fixedAttackRange ((LogicalColour -> Rank -> [Vector])
 -> ByRankByLogicalColour [Vector])
-> (LogicalColour -> Rank -> [Vector])
-> ByRankByLogicalColour [Vector]
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour -> \case
	Rank
Attribute.Rank.Pawn	-> LogicalColour -> [Vector]
Cartesian.Vector.attackVectorsForPawn LogicalColour
logicalColour
	Rank
Attribute.Rank.Knight	-> [Vector]
Cartesian.Vector.attackVectorsForKnight
	Rank
Attribute.Rank.King	-> [Vector]
Cartesian.Vector.attackVectorsForKing
	Rank
rank			-> String -> [Vector]
forall a. (?callStack::CallStack) => String -> a
error (String -> [Vector]) -> ShowS -> String -> [Vector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Component.Piece.attackVectorsByRankByLogicalColour:\trank must attack over fixed range; " (String -> [Vector]) -> String -> [Vector]
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
rank String
"."	-- These ranks attack over any distance.

-- | The destinations available to those pieces with attack-vectors; @Pawn@, @Knight@, @King@.
type AttackDestinationsByCoordinatesByRankByLogicalColour	= ByRankByLogicalColour (Cartesian.Coordinates.ArrayByCoordinates [Cartesian.Coordinates.Coordinates])

-- | Calls 'attackVectorsByRankByLogicalColour' to find the destinations which the specified /piece/ can attack from the specified position.
findAttackDestinations'
	:: Piece
	-> Cartesian.Coordinates.Coordinates	-- ^ The source from which the attack originates.
	-> [Cartesian.Coordinates.Coordinates]	-- ^ The destinations which can be attacked.
findAttackDestinations' :: Piece -> Coordinates -> [Coordinates]
findAttackDestinations' MkPiece {
	getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
	getRank :: Piece -> Rank
getRank			= Rank
rank
} Coordinates
source	= (Vector -> Maybe Coordinates) -> [Vector] -> [Coordinates]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (
	Vector -> Coordinates -> Maybe Coordinates
`Cartesian.Vector.maybeTranslate` Coordinates
source
 ) (
	ByRankByLogicalColour [Vector]
attackVectorsByRankByLogicalColour ByRankByLogicalColour [Vector]
-> LogicalColour -> Map Rank [Vector]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank [Vector] -> Rank -> [Vector]
forall k a. Ord k => Map k a -> k -> a
Map.! Rank
rank
 )

{- |
	* 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 :: AttackDestinationsByCoordinatesByRankByLogicalColour
attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour
attackDestinationsByCoordinatesByRankByLogicalColour	= [Rank]
-> (LogicalColour -> Rank -> Array Coordinates [Coordinates])
-> AttackDestinationsByCoordinatesByRankByLogicalColour
forall element.
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.fixedAttackRange ((LogicalColour -> Rank -> Array Coordinates [Coordinates])
 -> AttackDestinationsByCoordinatesByRankByLogicalColour)
-> (LogicalColour -> Rank -> Array Coordinates [Coordinates])
-> AttackDestinationsByCoordinatesByRankByLogicalColour
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour Rank
rank -> [[Coordinates]] -> Array Coordinates [Coordinates]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Coordinates e
Cartesian.Coordinates.listArrayByCoordinates ([[Coordinates]] -> Array Coordinates [Coordinates])
-> [[Coordinates]] -> Array Coordinates [Coordinates]
forall a b. (a -> b) -> a -> b
$ (Coordinates -> [Coordinates]) -> [Coordinates] -> [[Coordinates]]
forall a b. (a -> b) -> [a] -> [b]
map (
	Piece -> Coordinates -> [Coordinates]
findAttackDestinations' (Piece -> Coordinates -> [Coordinates])
-> Piece -> Coordinates -> [Coordinates]
forall a b. (a -> b) -> a -> b
$! LogicalColour -> Rank -> Piece
mkPiece LogicalColour
logicalColour Rank
rank
 ) [Coordinates]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

-- | Find the destinations which the specified /piece/ can attack from the specified position.
findAttackDestinations
	:: Piece
	-> Cartesian.Coordinates.Coordinates	-- ^ The source from which the attack originates.
	-> [Cartesian.Coordinates.Coordinates]	-- ^ The destinations which can be attacked.
findAttackDestinations :: Piece -> Coordinates -> [Coordinates]
findAttackDestinations MkPiece {
	getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
	getRank :: Piece -> Rank
getRank			= Rank
rank
} Coordinates
coordinates	= AttackDestinationsByCoordinatesByRankByLogicalColour
attackDestinationsByCoordinatesByRankByLogicalColour AttackDestinationsByCoordinatesByRankByLogicalColour
-> LogicalColour -> Map Rank (Array Coordinates [Coordinates])
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank (Array Coordinates [Coordinates])
-> Rank -> Array Coordinates [Coordinates]
forall k a. Ord k => Map k a -> k -> a
Map.! Rank
rank Array Coordinates [Coordinates] -> Coordinates -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
coordinates

-- The constant /direction/s of the straight lines along which each type of /piece/ can attack.


{- |
	* The constant /direction/s of the straight lines along which each type of /piece/ can attack.

	* CAVEAT: not defined for a @Knight@.
-}
attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Direction.Direction.Direction]
attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Direction]
attackDirectionsByRankByLogicalColour	= [Rank]
-> (LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction]
forall element.
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.earthBound ((LogicalColour -> Rank -> [Direction])
 -> ByRankByLogicalColour [Direction])
-> (LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction]
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour -> \case
	Rank
Attribute.Rank.Pawn	-> LogicalColour -> [Direction]
Direction.Direction.attackDirectionsForPawn LogicalColour
logicalColour
	Rank
Attribute.Rank.Bishop	-> [Direction]
Direction.Direction.diagonals
	Rank
Attribute.Rank.Rook	-> [Direction]
Direction.Direction.parallels
	Rank
_ {-royalty-}		-> [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members {-directions-}

{- |
	* Get the constant /direction/s of the straight lines along which the specified /piece/ can attack.

	* CAVEAT: not defined for a @Knight@.
-}
getAttackDirections :: Piece -> [Direction.Direction.Direction]
getAttackDirections :: Piece -> [Direction]
getAttackDirections MkPiece {
	getLogicalColour :: Piece -> LogicalColour
getLogicalColour	= LogicalColour
logicalColour,
	getRank :: Piece -> Rank
getRank			= Rank
rank
} = ByRankByLogicalColour [Direction]
attackDirectionsByRankByLogicalColour ByRankByLogicalColour [Direction]
-> LogicalColour -> Map Rank [Direction]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank [Direction] -> Rank -> [Direction]
forall k a. Ord k => Map k a -> k -> a
Map.! Rank
rank

{- |
	* 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
	:: Cartesian.Coordinates.Coordinates	-- ^ Source (attacker's location).
	-> Cartesian.Coordinates.Coordinates	-- ^ Destination (victim's location).
	-> Piece				-- ^ Attacker.
	-> Bool
canAttackAlong :: Coordinates -> Coordinates -> Piece -> Bool
canAttackAlong Coordinates
source Coordinates
destination Piece
piece	= (
	case Piece -> Rank
getRank Piece
piece of
		Rank
Attribute.Rank.Pawn	-> (Vector -> LogicalColour -> Bool
`Cartesian.Vector.isPawnAttack` Piece -> LogicalColour
getLogicalColour Piece
piece)
		Rank
Attribute.Rank.Knight	-> Vector -> Bool
Cartesian.Vector.isKnightsMove
		Rank
Attribute.Rank.Bishop	-> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal
		Rank
Attribute.Rank.Rook	-> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel
		Rank
Attribute.Rank.Queen	-> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight
		Rank
Attribute.Rank.King	-> Vector -> Bool
Cartesian.Vector.isKingsMove
 ) (Vector -> Bool) -> Vector -> Bool
forall a b. (a -> b) -> a -> b
$! Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
source Coordinates
destination

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

	* N.B.: can't detect any blocking pieces.
-}
canMoveBetween
	:: Piece
	-> Cartesian.Coordinates.Coordinates	-- ^ Source.
	-> Cartesian.Coordinates.Coordinates	-- ^ Destination.
	-> Bool
canMoveBetween :: Piece -> Coordinates -> Coordinates -> Bool
canMoveBetween Piece
piece Coordinates
source Coordinates
destination	= (
	case Piece -> Rank
getRank Piece
piece of
		Rank
Attribute.Rank.Pawn	-> let
			logicalColour :: LogicalColour
logicalColour	= Piece -> LogicalColour
getLogicalColour Piece
piece
		 in (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (Vector -> (Bool, Bool)) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			(Vector -> LogicalColour -> Bool
`Cartesian.Vector.isPawnAttack` LogicalColour
logicalColour) (Vector -> Bool) -> (Vector -> Bool) -> Vector -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
				(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (Vector -> (Bool, Bool)) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					(NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0) (NPieces -> Bool) -> (Vector -> NPieces) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector -> NPieces
Cartesian.Vector.getXDistance (Vector -> Bool) -> (Vector -> Bool) -> Vector -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
						\case
							NPieces
1	-> Bool
True
							NPieces
2	-> Coordinates -> LogicalColour -> Bool
Cartesian.Coordinates.isPawnsFirstRank Coordinates
source LogicalColour
logicalColour
							NPieces
_	-> Bool
False
					) (NPieces -> Bool) -> (Vector -> NPieces) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
						if LogicalColour -> Bool
Colour.LogicalColour.isBlack LogicalColour
logicalColour
							then NPieces -> NPieces
forall a. Num a => a -> a
negate
							else NPieces -> NPieces
forall a. a -> a
id
					) (NPieces -> NPieces) -> (Vector -> NPieces) -> Vector -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector -> NPieces
Cartesian.Vector.getYDistance
				)
			)
		 )
		Rank
Attribute.Rank.Knight	-> Vector -> Bool
Cartesian.Vector.isKnightsMove
		Rank
Attribute.Rank.Bishop	-> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal
		Rank
Attribute.Rank.Rook	-> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel
		Rank
Attribute.Rank.Queen	-> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight
		Rank
Attribute.Rank.King	-> Vector -> Bool
Cartesian.Vector.isKingsMove
 ) (Vector -> Bool) -> Vector -> Bool
forall a b. (a -> b) -> a -> b
$! Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
source Coordinates
destination

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

-- | Whether the specified /piece/ is @Black@.
{-# INLINE isBlack #-}
isBlack :: Piece -> Bool
isBlack :: Piece -> Bool
isBlack MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
Colour.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 ArrayByPiece	= 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)

-- | A /piece/ at specific /coordinates/.
type LocatedPiece	= (Cartesian.Coordinates.Coordinates, Piece)