{-
	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 <https://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	The details of a player's turn.
-}

module BishBosh.Component.Turn(
-- * Types
-- ** Data-types
	Turn(
--		MkTurn,
		getQualifiedMove,
		getRank,
		getIsRepeatableMove
	),
-- * Functions
	compareByLVA,
	compareByMVVLVA,
-- ** Constructor
	mkTurn,
-- ** Predicates
	isCapture,
	isPawnDoubleAdvance
) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Component.Move			as Component.Move
import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove
import qualified	BishBosh.Property.Reflectable		as Property.Reflectable
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Data.Default
import qualified	Data.Ord

{- |
	* Defines one turn of a player.

	* Additional data is recorded to facilitate both rollback & recording of the /move/ in various conventional notations.
-}
data Turn	= MkTurn {
	Turn -> QualifiedMove
getQualifiedMove	:: Component.QualifiedMove.QualifiedMove,
	Turn -> Rank
getRank			:: Attribute.Rank.Rank,	-- ^ The /rank/ of /piece/ that was moved, prior to any promotion.
	Turn -> Bool
getIsRepeatableMove	:: Bool			-- ^ Whether this move can ever recur; without rolling-back.
}

instance Eq Turn where
	MkTurn {
		getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMove,
		getRank :: Turn -> Rank
getRank			= Rank
rank
	} == :: Turn -> Turn -> Bool
== MkTurn {
		getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMove',
		getRank :: Turn -> Rank
getRank			= Rank
rank'
	} = (QualifiedMove
qualifiedMove, Rank
rank) (QualifiedMove, Rank) -> (QualifiedMove, Rank) -> Bool
forall a. Eq a => a -> a -> Bool
== (QualifiedMove
qualifiedMove', Rank
rank')	-- 'getIsRepeatableMove' can be derived.

instance Control.DeepSeq.NFData Turn where
	rnf :: Turn -> ()
rnf MkTurn {
		getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMove,
		getRank :: Turn -> Rank
getRank			= Rank
rank,
		getIsRepeatableMove :: Turn -> Bool
getIsRepeatableMove	= Bool
isRepeatableMove
	} = (QualifiedMove, Rank, Bool) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (QualifiedMove
qualifiedMove, Rank
rank, Bool
isRepeatableMove)

instance Show Turn where
	showsPrec :: Int -> Turn -> ShowS
showsPrec Int
precedence MkTurn {
		getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMove,
		getRank :: Turn -> Rank
getRank			= Rank
rank
--		getIsRepeatableMove	= isRepeatableMove
	} = Int -> (QualifiedMove, Rank) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence (
		QualifiedMove
qualifiedMove,
		Rank
rank
--		isRepeatableMove	-- Derived.
	 ) -- Represent as a tuple.

instance Read Turn where
	readsPrec :: Int -> ReadS Turn
readsPrec Int
precedence	= (((QualifiedMove, Rank), String) -> (Turn, String))
-> [((QualifiedMove, Rank), String)] -> [(Turn, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((QualifiedMove, Rank) -> Turn)
-> ((QualifiedMove, Rank), String) -> (Turn, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (((QualifiedMove, Rank) -> Turn)
 -> ((QualifiedMove, Rank), String) -> (Turn, String))
-> ((QualifiedMove, Rank) -> Turn)
-> ((QualifiedMove, Rank), String)
-> (Turn, String)
forall a b. (a -> b) -> a -> b
$ (QualifiedMove -> Rank -> Turn) -> (QualifiedMove, Rank) -> Turn
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry QualifiedMove -> Rank -> Turn
mkTurn) ([((QualifiedMove, Rank), String)] -> [(Turn, String)])
-> (String -> [((QualifiedMove, Rank), String)]) -> ReadS Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [((QualifiedMove, Rank), String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence

instance Property.Reflectable.ReflectableOnX Turn where
	reflectOnX :: Turn -> Turn
reflectOnX turn :: Turn
turn@MkTurn { getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove = QualifiedMove
qualifiedMove } = Turn
turn { getQualifiedMove :: QualifiedMove
getQualifiedMove = QualifiedMove -> QualifiedMove
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX QualifiedMove
qualifiedMove }

-- | Smart constructor.
mkTurn
	:: Component.QualifiedMove.QualifiedMove
	-> Attribute.Rank.Rank
	-> Turn
mkTurn :: QualifiedMove -> Rank -> Turn
mkTurn QualifiedMove
qualifiedMove Rank
rank = MkTurn :: QualifiedMove -> Rank -> Bool -> Turn
MkTurn {
	getQualifiedMove :: QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMove,
	getRank :: Rank
getRank			= Rank
rank,
	getIsRepeatableMove :: Bool
getIsRepeatableMove	= Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.Pawn {-can't retreat-} Bool -> Bool -> Bool
&& Bool -> Bool
not (
		MoveType -> Bool
Attribute.MoveType.isAcyclic (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove
	) -- Infer.
}

-- | Convenience.
isCapture :: Turn -> Bool
isCapture :: Turn -> Bool
isCapture MkTurn { getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove = QualifiedMove
qualifiedMove }	= MoveType -> Bool
Attribute.MoveType.isCapture (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove

-- | Whether the /turn/ represents a @Pawn@'s initial two-square advance.
isPawnDoubleAdvance
	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side whose /turn/ is referenced.
	-> Turn
	-> Bool
isPawnDoubleAdvance :: LogicalColour -> Turn -> Bool
isPawnDoubleAdvance LogicalColour
logicalColour MkTurn {
	getRank :: Turn -> Rank
getRank			= Rank
Attribute.Rank.Pawn,
	getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMove
} = LogicalColour -> Move -> Bool
Component.Move.isPawnDoubleAdvance LogicalColour
logicalColour (QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove) Bool -> Bool -> Bool
&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove MoveType -> MoveType -> Bool
forall a. Eq a => a -> a -> Bool
== MoveType
forall a. Default a => a
Data.Default.def
isPawnDoubleAdvance LogicalColour
_ Turn
_	= Bool
False

-- | Forwards the request to 'Attribute.Rank.compareByLVA'.
compareByLVA
	:: Attribute.Rank.EvaluateRank
	-> Turn
	-> Turn
	-> Ordering
compareByLVA :: EvaluateRank -> Turn -> Turn -> Ordering
compareByLVA EvaluateRank
evaluateRank MkTurn { getRank :: Turn -> Rank
getRank = Rank
rankL } MkTurn { getRank :: Turn -> Rank
getRank = Rank
rankR }	= EvaluateRank -> Rank -> Rank -> Ordering
Attribute.Rank.compareByLVA EvaluateRank
evaluateRank Rank
rankL Rank
rankR

{- |
	* Compares /turn/s by <https://www.chessprogramming.org/MVV-LVA>.

	* This orders the most valuable victim of an attack first, but when victims are of equal rank, orders the least valuable aggressor first.

	* N.B.: the order of non-capture moves (including promotions) isn't defined.

	* CAVEAT: no account is made for any defenders of the attacked piece, which might recoup transient gains.
-}
compareByMVVLVA
	:: Attribute.Rank.EvaluateRank
	-> Turn
	-> Turn
	-> Ordering
compareByMVVLVA :: EvaluateRank -> Turn -> Turn -> Ordering
compareByMVVLVA EvaluateRank
evaluateRank turnL :: Turn
turnL@MkTurn {
	getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMoveL
} turnR :: Turn
turnR@MkTurn {
	getQualifiedMove :: Turn -> QualifiedMove
getQualifiedMove	= QualifiedMove
qualifiedMoveR
} = case ((QualifiedMove -> Maybe Rank) -> QualifiedMove -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ QualifiedMove
qualifiedMoveL) ((QualifiedMove -> Maybe Rank) -> Maybe Rank)
-> ((QualifiedMove -> Maybe Rank) -> Maybe Rank)
-> (QualifiedMove -> Maybe Rank)
-> (Maybe Rank, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((QualifiedMove -> Maybe Rank) -> QualifiedMove -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ QualifiedMove
qualifiedMoveR) ((QualifiedMove -> Maybe Rank) -> (Maybe Rank, Maybe Rank))
-> (QualifiedMove -> Maybe Rank) -> (Maybe Rank, Maybe Rank)
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe Rank
Attribute.MoveType.getMaybeImplicitlyTakenRank (MoveType -> Maybe Rank)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType of
	(Maybe Rank
Nothing, Maybe Rank
Nothing)	-> Ordering
EQ
	(Maybe Rank
Nothing, Maybe Rank
_)		-> Ordering
GT
	(Maybe Rank
_, Maybe Rank
Nothing)		-> Ordering
LT
	(Just Rank
rankL, Just Rank
rankR)
		| Rank
rankL Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
rankR	-> Ordering
lvaComparison
		| Bool
otherwise		-> case EvaluateRank -> Rank -> Rank -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing EvaluateRank
evaluateRank Rank
rankR Rank
rankL {-MVV-} of
			Ordering
EQ		-> Ordering
lvaComparison
			Ordering
ordering	-> Ordering
ordering	-- MVV-comparison uniquely defines the order.
	where
		lvaComparison :: Ordering
lvaComparison	= EvaluateRank -> Turn -> Turn -> Ordering
compareByLVA EvaluateRank
evaluateRank Turn
turnL Turn
turnR