{-
	Copyright (C) 2021 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 all possible castling-moves.
-}

module BishBosh.Component.CastlingMove(
-- * Types
-- ** Data-types
	CastlingMove(
--		MkCastlingMove,
		getMoveType,
		getKingsMove,
		getRooksMove
	),
-- * Constants
	kingsMoveLength,
--	castlingMovesByLogicalColour,
-- * Functions
--	defineCastlingMoves,
	getLongAndShortMoves,
-- ** Accessors
	getCastlingMoves,
--	getCastlingMovesInt
) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
import qualified	BishBosh.Component.Move			as Component.Move
import qualified	BishBosh.Data.Enum			as Data.Enum
import qualified	BishBosh.Data.Exception			as Data.Exception
import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Type.Length			as Type.Length
import qualified	Control.Exception

-- | Defines a castling-move.
data CastlingMove x y	= MkCastlingMove {
	CastlingMove x y -> MoveType
getMoveType	:: Attribute.MoveType.MoveType,	-- ^ CAVEAT: should only be a castling-move type.
	CastlingMove x y -> Move x y
getKingsMove	:: Component.Move.Move x y,
	CastlingMove x y -> Move x y
getRooksMove	:: Component.Move.Move x y
}

-- | The constant number of files over which the King always travels when castling.
kingsMoveLength :: Num x => x
kingsMoveLength :: x
kingsMoveLength	= x
2

-- | Define all possible castling-moves for the specified /logical colour/.
defineCastlingMoves :: (
	Enum	x,
	Enum	y,
	Eq	y,
	Ord	x
 ) => Attribute.LogicalColour.LogicalColour -> [CastlingMove x y]
defineCastlingMoves :: LogicalColour -> [CastlingMove x y]
defineCastlingMoves LogicalColour
logicalColour	= [
	MkCastlingMove :: forall x y. MoveType -> Move x y -> Move x y -> CastlingMove x y
MkCastlingMove {
		getMoveType :: MoveType
getMoveType	= MoveType
Attribute.MoveType.longCastle,
		getKingsMove :: Move x y
getKingsMove	= (Int -> Int) -> Move x y
kingsMove ((Int -> Int) -> Move x y) -> (Int -> Int) -> Move x y
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
forall x. Num x => x
kingsMoveLength,
		getRooksMove :: Move x y
getRooksMove	= (Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y -> (Coordinates x y, Coordinates x y))
-> Coordinates x y
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Coordinates x y
forall a. a -> a
id (Coordinates x y -> Coordinates x y)
-> (Coordinates x y -> Coordinates x y)
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Int -> Int) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(Int -> Int) -> Coordinates x y -> Coordinates x y
translateX (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if Bool
isBlack
			then Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
Cartesian.Coordinates.topLeft
			else Coordinates x y
forall a. Bounded a => a
minBound
	}, MkCastlingMove :: forall x y. MoveType -> Move x y -> Move x y -> CastlingMove x y
MkCastlingMove {
		getMoveType :: MoveType
getMoveType	= MoveType
Attribute.MoveType.shortCastle,
		getKingsMove :: Move x y
getKingsMove	= (Int -> Int) -> Move x y
kingsMove (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forall x. Num x => x
kingsMoveLength),
		getRooksMove :: Move x y
getRooksMove	= (Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y -> (Coordinates x y, Coordinates x y))
-> Coordinates x y
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Coordinates x y
forall a. a -> a
id (Coordinates x y -> Coordinates x y)
-> (Coordinates x y -> Coordinates x y)
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Int -> Int) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(Int -> Int) -> Coordinates x y -> Coordinates x y
translateX (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if Bool
isBlack
			then Coordinates x y
forall a. Bounded a => a
maxBound
			else Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
Cartesian.Coordinates.bottomRight
	}
 ] where
	isBlack :: Bool
	isBlack :: Bool
isBlack	= LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour

	kingsStartingCoordinates :: Coordinates x y
kingsStartingCoordinates	= LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour
	kingsMove :: (Int -> Int) -> Move x y
kingsMove Int -> Int
translation		= Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
kingsStartingCoordinates (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(Int -> Int) -> Coordinates x y -> Coordinates x y
translateX Int -> Int
translation Coordinates x y
kingsStartingCoordinates

	translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y
	translateX :: (Int -> Int) -> Coordinates x y -> Coordinates x y
translateX	= (x -> x) -> Coordinates x y -> Coordinates x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX ((x -> x) -> Coordinates x y -> Coordinates x y)
-> ((Int -> Int) -> x -> x)
-> (Int -> Int)
-> Coordinates x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> x -> x
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate

-- | Defines by /logical colour/, the constant list of all possible castling-moves.
castlingMovesByLogicalColour :: (
	Enum	x,
	Enum	y,
	Eq	y,
	Ord	x
 ) => Attribute.LogicalColour.ArrayByLogicalColour [CastlingMove x y]
castlingMovesByLogicalColour :: ArrayByLogicalColour [CastlingMove x y]
castlingMovesByLogicalColour	= [[CastlingMove x y]] -> ArrayByLogicalColour [CastlingMove x y]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([[CastlingMove x y]] -> ArrayByLogicalColour [CastlingMove x y])
-> [[CastlingMove x y]] -> ArrayByLogicalColour [CastlingMove x y]
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> [CastlingMove x y])
-> [LogicalColour] -> [[CastlingMove x y]]
forall a b. (a -> b) -> [a] -> [b]
map LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
defineCastlingMoves [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

{- |
	* Accessor.

	* CAVEAT: the moves are returned in unspecified order.
-}
getCastlingMoves :: (
	Enum	x,
	Enum	y,
	Eq	y,
	Ord	x
 ) => Attribute.LogicalColour.LogicalColour -> [CastlingMove x y]
{-# NOINLINE getCastlingMoves #-}	-- Ensure the rewrite-rule triggers.
{-# RULES "getCastlingMoves/Int" getCastlingMoves = getCastlingMovesInt #-}
getCastlingMoves :: LogicalColour -> [CastlingMove x y]
getCastlingMoves	= LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
defineCastlingMoves

-- | A specialisation of 'getCastlingMoves'.
getCastlingMovesInt :: Attribute.LogicalColour.LogicalColour -> [CastlingMove Type.Length.X Type.Length.Y]
getCastlingMovesInt :: LogicalColour -> [CastlingMove Int Int]
getCastlingMovesInt	= (ArrayByLogicalColour [CastlingMove Int Int]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
ArrayByLogicalColour [CastlingMove x y]
castlingMovesByLogicalColour ArrayByLogicalColour [CastlingMove Int Int]
-> LogicalColour -> [CastlingMove Int Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)

-- | Break-down the two castling-moves for the specified /logical colour/ into a long & a short castling-move.
getLongAndShortMoves :: (
	Enum	x,
	Enum	y,
	Eq	y,
	Ord	x
 ) => Attribute.LogicalColour.LogicalColour -> (CastlingMove x y, CastlingMove x y)
{-# SPECIALISE getLongAndShortMoves :: Attribute.LogicalColour.LogicalColour -> (CastlingMove Type.Length.X Type.Length.Y, CastlingMove Type.Length.X Type.Length.Y) #-}
getLongAndShortMoves :: LogicalColour -> (CastlingMove x y, CastlingMove x y)
getLongAndShortMoves LogicalColour
logicalColour
	| [CastlingMove x y
longCastlingMove, CastlingMove x y
shortCastlingMove] <- LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
getCastlingMoves LogicalColour
logicalColour	= (CastlingMove x y
longCastlingMove, CastlingMove x y
shortCastlingMove)
	| Bool
otherwise									= Exception -> (CastlingMove x y, CastlingMove x y)
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> (CastlingMove x y, CastlingMove x y))
-> Exception -> (CastlingMove x y, CastlingMove x y)
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkIncompatibleData String
"BishBosh.Component.CastlingMove.getLongAndShortMoves:\tunexpected list-length."