{-
	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
) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour
import qualified	BishBosh.Component.Move			as Component.Move
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	= MkCastlingMove {
	CastlingMove -> MoveType
getMoveType	:: Attribute.MoveType.MoveType,	-- ^ CAVEAT: should only be a castling-move type.
	CastlingMove -> Move
getKingsMove	:: Component.Move.Move,
	CastlingMove -> Move
getRooksMove	:: Component.Move.Move
}

-- | The constant number of files over which the @King@ always travels when castling.
kingsMoveLength :: Type.Length.X
kingsMoveLength :: X
kingsMoveLength	= X
2

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

	kingsMove :: (X -> X) -> Move
kingsMove X -> X
translation	= ((Coordinates -> Move) -> Coordinates -> Move)
-> (Coordinates -> Move, Coordinates) -> Move
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Coordinates -> Move) -> Coordinates -> Move
forall a b. (a -> b) -> a -> b
($) ((Coordinates -> Move, Coordinates) -> Move)
-> (Coordinates -> (Coordinates -> Move, Coordinates))
-> Coordinates
-> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates -> Coordinates -> Move
Component.Move.mkMove (Coordinates -> Coordinates -> Move)
-> (Coordinates -> Coordinates)
-> Coordinates
-> (Coordinates -> Move, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (X -> X) -> Coordinates -> Coordinates
Cartesian.Coordinates.translateX X -> X
translation) (Coordinates -> Move) -> Coordinates -> Move
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour

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

{- |
	* Accessor.

	* CAVEAT: the moves are returned in unspecified order.
-}
getCastlingMoves :: Colour.LogicalColour.LogicalColour -> [CastlingMove]
getCastlingMoves :: LogicalColour -> [CastlingMove]
getCastlingMoves	= (ArrayByLogicalColour [CastlingMove]
castlingMovesByLogicalColour ArrayByLogicalColour [CastlingMove]
-> LogicalColour -> [CastlingMove]
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 :: Colour.LogicalColour.LogicalColour -> (CastlingMove, CastlingMove)
getLongAndShortMoves :: LogicalColour -> (CastlingMove, CastlingMove)
getLongAndShortMoves LogicalColour
logicalColour
	| [CastlingMove
longCastlingMove, CastlingMove
shortCastlingMove] <- LogicalColour -> [CastlingMove]
getCastlingMoves LogicalColour
logicalColour	= (CastlingMove
longCastlingMove, CastlingMove
shortCastlingMove)
	| Bool
otherwise									= Exception -> (CastlingMove, CastlingMove)
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> (CastlingMove, CastlingMove))
-> Exception -> (CastlingMove, CastlingMove)
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkIncompatibleData String
"BishBosh.Component.CastlingMove.getLongAndShortMoves:\tunexpected list-length."