{-
	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@]	Categorises /move/s, & provides ancillary information as required.
-}

module BishBosh.Attribute.MoveType(
-- * Types
-- ** Type-synonyms
--	IsShort,
-- ** Data-types
	MoveType(
		Castle,
		EnPassant,
		Normal
	),
-- * Constants
	tag,
	shortCastle,
	longCastle,
	enPassant,
-- * Functions
	nPiecesMutator,
-- ** Constructors
	mkMaybeNormalMoveType,
	mkNormalMoveType,
-- ** Predicates
	isCastle,
	isEnPassant,
--	isNormal,
	isCapture,
	isPromotion,
	isQuiet,
	isAcyclic,
-- ** Query
	getMaybeExplicitlyTakenRank,
	getMaybeImplicitlyTakenRank
) where

import qualified	BishBosh.Attribute.Rank	as Attribute.Rank
import qualified	BishBosh.Text.ShowList	as Text.ShowList
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Data.List.Extra
import qualified	Data.Maybe

-- | Used to qualify output.
tag :: String
tag	= "moveType"

-- | Self-documentation.
type IsShort	= Bool

-- | Constant value required to denote a /short castle/.
shortCastle :: MoveType
shortCastle	= Castle True

-- | Constant value required to denote a /long castle/.
longCastle :: MoveType
longCastle	= Castle False

-- | Constant.
enPassant :: MoveType
enPassant	= EnPassant

-- | Classifies the distinct types of /move/.
data MoveType
	= Castle IsShort	-- ^ Castling between the @King@ & one of its @Rook@s.
	| EnPassant		-- ^ Capture by a @Pawn@ of a @Pawn@ as it advanced two squares.
	| Normal {
		_getMaybeTakenRank	:: Maybe Attribute.Rank.Rank,	-- ^ The /rank/ of any opposing /piece/ which was just taken.
		_getMaybePromotionRank	:: Maybe Attribute.Rank.Rank	-- ^ The /rank/ of any /piece/ to which a @Pawn@ was just promoted.
	}
	deriving Eq

instance Show MoveType where
	showsPrec _ (Castle isShort)				= showString "Castle (short" . Text.ShowList.showsAssociation . shows isShort . showChar ')'
	showsPrec _ EnPassant					= showString "En-passant"
	showsPrec _ (Normal maybeTakenRank maybePromotionRank)	= Text.ShowList.showsAssociationList' $ Data.Maybe.catMaybes [
		fmap ((,) "takenRank" . shows) maybeTakenRank,
		fmap ((,) "promotionRank" . shows) maybePromotionRank
	 ]

instance Read MoveType where
	readsPrec _ s	= case Data.List.Extra.trimStart s of
		'C' : 'a' : 's' : 't' : 'l' : 'e' : s1	-> [
			(Castle isShort, remainder) |
				("(", s2)		<- lex s1,
				("short", s3)		<- lex s2,
				("=", s4)		<- lex s3,
				(isShort, s5)		<- reads s4,
				(")", remainder)	<- lex s5
		 ] -- List-comprehension.
		'E' : 'n' : '-' : 'p' : 'a' : 's' : 's' : 'a' : 'n' : 't' : remainder	-> [(EnPassant, remainder)]
		_ -> [
			(normalMoveType, remainder) |
				("{", s1)			<- lex s,
				(maybeTakenRank, s2)		<- case [
					pair |
						("takenRank", s11)	<- lex s1,
						("=", s12)		<- lex s11,
						pair			<- reads s12
				] of
					[]	-> [(Nothing, s1)]	-- Infer that nothing was taken.
					parsed	-> map (Control.Arrow.first Just) parsed,
				s3	<- return $ case lex s2 of
					[(",", s21)]	-> s21
					_		-> s2,
				(maybePromotionRank, s4)	<- case [
					pair |
						("promotionRank", s31)	<- lex s3,
						("=", s32)		<- lex s31,
						pair			<- reads s32
				] of
					[]	-> [(Nothing, s3)]	-- Infer that there was no promotion.
					parsed	-> map (Control.Arrow.first Just) parsed,
				("}", remainder)		<- lex s4,
				normalMoveType			<- Data.Maybe.maybeToList $ mkMaybeNormalMoveType maybeTakenRank maybePromotionRank
		 ] -- List-comprehension.

instance Control.DeepSeq.NFData MoveType where
	rnf (Castle isShort)	= Control.DeepSeq.rnf isShort
	rnf (Normal t p)	= Control.DeepSeq.rnf (t, p)
	rnf _			= ()

instance Data.Default.Default MoveType where
	def	= Normal Nothing Nothing

instance Attribute.Rank.Promotable MoveType where
	getMaybePromotionRank (Normal _ maybePromotionRank)	= maybePromotionRank
	getMaybePromotionRank _					= Nothing

-- | Smart-constructor for normal move-types.
mkMaybeNormalMoveType
	:: Maybe Attribute.Rank.Rank	-- ^ The /rank/ of any opposing /piece/ which was just taken.
	-> Maybe Attribute.Rank.Rank	-- ^ The /rank/ to which a @Pawn@ was just promoted.
	-> Maybe MoveType		-- ^ Maybe the required /move-type/.
mkMaybeNormalMoveType maybeTakenRank maybePromotionRank
	| Data.Maybe.maybe True {-nothing taken-} (/= Attribute.Rank.King) maybeTakenRank
	, Data.Maybe.maybe True {-nothing promoted-} (
		`elem` Attribute.Rank.promotionProspects
	) maybePromotionRank	= Just $ Normal maybeTakenRank maybePromotionRank
	| otherwise		= Nothing

-- | Smart-constructor for normal move-types.
mkNormalMoveType
	:: Maybe Attribute.Rank.Rank	-- ^ The /rank/ of any opposing /piece/ which is to be taken.
	-> Maybe Attribute.Rank.Rank	-- ^ The /rank/ to which a @Pawn@ is to be promoted.
	-> MoveType
mkNormalMoveType maybeTakenRank maybePromotionRank	= Control.Exception.assert (
	Data.Maybe.maybe True {-nothing taken-} (
		/= Attribute.Rank.King
	) maybeTakenRank && Data.Maybe.maybe True {-nothing promoted-} (
		`elem` Attribute.Rank.promotionProspects
	) maybePromotionRank
 ) $ Normal maybeTakenRank maybePromotionRank

-- | Predicate.
isCastle :: MoveType -> Bool
isCastle (Castle _)	= True
isCastle _		= False

-- | Predicate.
isEnPassant :: MoveType -> Bool
isEnPassant EnPassant	= True
isEnPassant _		= False

-- | Whether the /move/ was neither @EnPassant@ nor @Castle@.
isNormal :: MoveType -> Bool
isNormal (Normal _ _)	= True
isNormal _		= False

-- | Whether a piece was captured, including @Pawn@s taken En-passant.
isCapture :: MoveType -> Bool
{-# INLINE isCapture #-}
isCapture (Normal (Just _) _)	= True
isCapture moveType		= isEnPassant moveType

-- | Whether the /move/ includes @Pawn@-promotion.
isPromotion :: MoveType -> Bool
isPromotion (Normal _ (Just _))	= True
isPromotion _			= False

-- | <https://chessprogramming.wikispaces.com/Quiet+Moves>.
isQuiet :: MoveType -> Bool
isQuiet (Normal Nothing Nothing)	= True
isQuiet	moveType			= isCastle moveType

{- |
	* Whether the /move/ can't be a member of a repeated cycle.

	* CAVEAT: one can't infer from a negative result that the move can be repeated, since the mover may have been a @Pawn@.
-}
isAcyclic :: MoveType -> Bool
isAcyclic (Normal Nothing Nothing)	= False
isAcyclic _				= True

-- | Query whether a /piece/ was explicitly taken, excluding @Pawn@s taken En-passant.
getMaybeExplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeExplicitlyTakenRank (Normal maybeTakenRank _)	= maybeTakenRank
getMaybeExplicitlyTakenRank _				= Nothing

-- | Query whether a /piece/ was taken either explicitly, or implicitly during En-passant.
getMaybeImplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank
getMaybeImplicitlyTakenRank EnPassant	= Just Attribute.Rank.Pawn
getMaybeImplicitlyTakenRank moveType	= getMaybeExplicitlyTakenRank moveType

-- | Returns the mutator required to adjust the number of pieces after a move.
nPiecesMutator :: Enum nPieces => MoveType -> (nPieces -> nPieces)
{-# INLINE nPiecesMutator #-}
nPiecesMutator moveType
	| isCapture moveType	= pred
	| otherwise		= id