{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

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

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

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

 [@DESCRIPTION@]	Defines the file on which an En-passant option currently exists.
-}

module BishBosh.State.EnPassantAbscissa (
-- * Types
-- ** Data-types
	EnPassantAbscissa(getAbscissa),
-- * Functions
-- ** Constructor
	mkMaybeEnPassantAbscissa
) where

import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
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.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Property.Opposable		as Property.Opposable
import qualified	BishBosh.State.MaybePieceByCoordinates	as State.MaybePieceByCoordinates
import qualified	BishBosh.Type.Length			as Type.Length
import qualified	Control.DeepSeq
import qualified	Data.Array.IArray
import qualified	Data.Maybe

-- | Defines the file on which an En-passant option currently exists.
newtype EnPassantAbscissa x	= MkEnPassantAbscissa {
	EnPassantAbscissa x -> x
getAbscissa	:: x	-- ^ The file on which an En-passant option currently exists.
} deriving (EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
(EnPassantAbscissa x -> EnPassantAbscissa x -> Bool)
-> (EnPassantAbscissa x -> EnPassantAbscissa x -> Bool)
-> Eq (EnPassantAbscissa x)
forall x.
Eq x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
$c/= :: forall x.
Eq x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
== :: EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
$c== :: forall x.
Eq x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
Eq, Eq (EnPassantAbscissa x)
Eq (EnPassantAbscissa x)
-> (EnPassantAbscissa x -> EnPassantAbscissa x -> Ordering)
-> (EnPassantAbscissa x -> EnPassantAbscissa x -> Bool)
-> (EnPassantAbscissa x -> EnPassantAbscissa x -> Bool)
-> (EnPassantAbscissa x -> EnPassantAbscissa x -> Bool)
-> (EnPassantAbscissa x -> EnPassantAbscissa x -> Bool)
-> (EnPassantAbscissa x
    -> EnPassantAbscissa x -> EnPassantAbscissa x)
-> (EnPassantAbscissa x
    -> EnPassantAbscissa x -> EnPassantAbscissa x)
-> Ord (EnPassantAbscissa x)
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
EnPassantAbscissa x -> EnPassantAbscissa x -> Ordering
EnPassantAbscissa x -> EnPassantAbscissa x -> EnPassantAbscissa x
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
forall x. Ord x => Eq (EnPassantAbscissa x)
forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Ordering
forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> EnPassantAbscissa x
min :: EnPassantAbscissa x -> EnPassantAbscissa x -> EnPassantAbscissa x
$cmin :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> EnPassantAbscissa x
max :: EnPassantAbscissa x -> EnPassantAbscissa x -> EnPassantAbscissa x
$cmax :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> EnPassantAbscissa x
>= :: EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
$c>= :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
> :: EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
$c> :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
<= :: EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
$c<= :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
< :: EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
$c< :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Bool
compare :: EnPassantAbscissa x -> EnPassantAbscissa x -> Ordering
$ccompare :: forall x.
Ord x =>
EnPassantAbscissa x -> EnPassantAbscissa x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (EnPassantAbscissa x)
Ord)

instance Data.Array.IArray.Ix x => Component.Zobrist.Hashable1D EnPassantAbscissa x {-CAVEAT: FlexibleInstances, MultiParamTypeClasses-} where
	listRandoms1D :: EnPassantAbscissa x -> Zobrist x y positionHash -> [positionHash]
listRandoms1D MkEnPassantAbscissa { getAbscissa :: forall x. EnPassantAbscissa x -> x
getAbscissa = x
x }	= positionHash -> [positionHash]
forall (m :: * -> *) a. Monad m => a -> m a
return {-to List-monad-} (positionHash -> [positionHash])
-> (Zobrist x y positionHash -> positionHash)
-> Zobrist x y positionHash
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
Ix x =>
x -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByEnPassantAbscissa x
x

instance Control.DeepSeq.NFData x => Control.DeepSeq.NFData (EnPassantAbscissa x) where
	rnf :: EnPassantAbscissa x -> ()
rnf MkEnPassantAbscissa { getAbscissa :: forall x. EnPassantAbscissa x -> x
getAbscissa = x
x }	= x -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf x
x

-- | Constructor.
mkMaybeEnPassantAbscissa :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> Attribute.LogicalColour.LogicalColour	-- ^ The player who moves next, & who may have an En-passant capture-option.
	-> State.MaybePieceByCoordinates.MaybePieceByCoordinates x y
	-> Component.Turn.Turn x y			-- ^ The last /turn/ taken.
	-> Maybe (EnPassantAbscissa x)
{-# SPECIALISE mkMaybeEnPassantAbscissa :: Attribute.LogicalColour.LogicalColour -> State.MaybePieceByCoordinates.MaybePieceByCoordinates Type.Length.X Type.Length.Y -> Component.Turn.Turn Type.Length.X Type.Length.Y -> Maybe (EnPassantAbscissa Type.Length.X) #-}
mkMaybeEnPassantAbscissa :: LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
mkMaybeEnPassantAbscissa LogicalColour
nextLogicalColour MaybePieceByCoordinates x y
maybePieceByCoordinates Turn x y
lastTurn
	| LogicalColour -> Turn x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Turn x y -> Bool
Component.Turn.isPawnDoubleAdvance (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) Turn x y
lastTurn
	, let lastMoveDestination :: Coordinates x y
lastMoveDestination	= Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Coordinates x y)
-> (QualifiedMove x y -> Move x y)
-> QualifiedMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Coordinates x y)
-> QualifiedMove x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
lastTurn
	, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Piece] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [
		Piece
passedPawn |
			Coordinates x y
adjacentCoordinates	<- Coordinates x y -> [Coordinates x y]
forall x y. (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.getAdjacents Coordinates x y
lastMoveDestination,
			LogicalColour -> Piece
Component.Piece.mkKing LogicalColour
nextLogicalColour {- Will I expose my King ? -} Piece -> [Piece] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [
				Piece
blockingPiece |
					Direction
threatDirection		<- [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,	-- Consider all directions.
					(Coordinates x y
_, Rank
attackerRank)	<- Maybe (Coordinates x y, Rank) -> [(Coordinates x y, Rank)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y, Rank) -> [(Coordinates x y, Rank)])
-> Maybe (Coordinates x y, Rank) -> [(Coordinates x y, Rank)]
forall a b. (a -> b) -> a -> b
$ LogicalColour
-> Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (Coordinates x y, Rank)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (Coordinates x y, Rank)
State.MaybePieceByCoordinates.findAttackerInDirection LogicalColour
nextLogicalColour Direction
threatDirection Coordinates x y
adjacentCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates,	-- Find discovered attacks.
					Rank
attackerRank Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rank]
Attribute.Rank.fixedAttackRange,	-- Any viable attack through the vacated square must be long-range.
					(Coordinates x y
_, Piece
blockingPiece)	<- Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)])
-> Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a b. (a -> b) -> a -> b
$ Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (Coordinates x y, Piece)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (LocatedPiece x y)
State.MaybePieceByCoordinates.findBlockingPiece (Direction -> Direction
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Direction
threatDirection) Coordinates x y
adjacentCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates	-- Find any discovered attack.
			], -- Confirm that the En-passant capture doesn't expose my King.
			Piece
passedPawn		<- (Piece -> Bool) -> [Piece] -> [Piece]
forall a. (a -> Bool) -> [a] -> [a]
filter (Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
nextLogicalColour) ([Piece] -> [Piece])
-> (Maybe Piece -> [Piece]) -> Maybe Piece -> [Piece]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Piece -> [Piece]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe Piece -> [Piece]) -> Maybe Piece -> [Piece]
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
adjacentCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates
	] = EnPassantAbscissa x -> Maybe (EnPassantAbscissa x)
forall a. a -> Maybe a
Just (EnPassantAbscissa x -> Maybe (EnPassantAbscissa x))
-> (x -> EnPassantAbscissa x) -> x -> Maybe (EnPassantAbscissa x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> EnPassantAbscissa x
forall x. x -> EnPassantAbscissa x
MkEnPassantAbscissa (x -> Maybe (EnPassantAbscissa x))
-> x -> Maybe (EnPassantAbscissa x)
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
lastMoveDestination
	| Bool
otherwise	= Maybe (EnPassantAbscissa x)
forall a. Maybe a
Nothing