{-
	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 :: String
tag	= String
"moveType"

-- | Self-documentation.
type IsShort	= Bool

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

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

-- | Constant.
enPassant :: MoveType
enPassant :: MoveType
enPassant	= MoveType
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 {
		MoveType -> Maybe Rank
_getMaybeTakenRank	:: Maybe Attribute.Rank.Rank,	-- ^ The /rank/ of any opposing /piece/ which was just taken.
		MoveType -> Maybe Rank
_getMaybePromotionRank	:: Maybe Attribute.Rank.Rank	-- ^ The /rank/ of any /piece/ to which a @Pawn@ was just promoted.
	}
	deriving MoveType -> MoveType -> IsShort
(MoveType -> MoveType -> IsShort)
-> (MoveType -> MoveType -> IsShort) -> Eq MoveType
forall a. (a -> a -> IsShort) -> (a -> a -> IsShort) -> Eq a
/= :: MoveType -> MoveType -> IsShort
$c/= :: MoveType -> MoveType -> IsShort
== :: MoveType -> MoveType -> IsShort
$c== :: MoveType -> MoveType -> IsShort
Eq

instance Show MoveType where
	showsPrec :: Int -> MoveType -> ShowS
showsPrec Int
_ (Castle IsShort
isShort)				= String -> ShowS
showString String
"Castle (short" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsShort -> ShowS
forall a. Show a => a -> ShowS
shows IsShort
isShort ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
	showsPrec Int
_ MoveType
EnPassant					= String -> ShowS
showString String
"En-passant"
	showsPrec Int
_ (Normal Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank)	= [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ [Maybe (String, ShowS)] -> [(String, ShowS)]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes [
		(Rank -> (String, ShowS)) -> Maybe Rank -> Maybe (String, ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) String
"takenRank" (ShowS -> (String, ShowS))
-> (Rank -> ShowS) -> Rank -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> ShowS
forall a. Show a => a -> ShowS
shows) Maybe Rank
maybeTakenRank,
		(Rank -> (String, ShowS)) -> Maybe Rank -> Maybe (String, ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) String
"promotionRank" (ShowS -> (String, ShowS))
-> (Rank -> ShowS) -> Rank -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> ShowS
forall a. Show a => a -> ShowS
shows) Maybe Rank
maybePromotionRank
	 ]

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

instance Control.DeepSeq.NFData MoveType where
	rnf :: MoveType -> ()
rnf (Castle IsShort
isShort)	= IsShort -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf IsShort
isShort
	rnf (Normal Maybe Rank
t Maybe Rank
p)	= (Maybe Rank, Maybe Rank) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Maybe Rank
t, Maybe Rank
p)
	rnf MoveType
_			= ()

instance Data.Default.Default MoveType where
	def :: MoveType
def	= Maybe Rank -> Maybe Rank -> MoveType
Normal Maybe Rank
forall a. Maybe a
Nothing Maybe Rank
forall a. Maybe a
Nothing

instance Attribute.Rank.Promotable MoveType where
	getMaybePromotionRank :: MoveType -> Maybe Rank
getMaybePromotionRank (Normal Maybe Rank
_ Maybe Rank
maybePromotionRank)	= Maybe Rank
maybePromotionRank
	getMaybePromotionRank MoveType
_					= Maybe Rank
forall a. Maybe a
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 :: Maybe Rank -> Maybe Rank -> Maybe MoveType
mkMaybeNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank
	| Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> IsShort
forall a. Eq a => a -> a -> IsShort
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King
	, IsShort -> (Rank -> IsShort) -> Maybe Rank -> IsShort
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsShort
True {-nothing promoted-} (
		Rank -> [Rank] -> IsShort
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsShort
`elem` [Rank]
Attribute.Rank.promotionProspects
	) Maybe Rank
maybePromotionRank	= MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just (MoveType -> Maybe MoveType) -> MoveType -> Maybe MoveType
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Normal Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank
	| IsShort
otherwise		= Maybe MoveType
forall a. Maybe a
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 :: Maybe Rank -> Maybe Rank -> MoveType
mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank	= IsShort -> MoveType -> MoveType
forall a. (?callStack::CallStack) => IsShort -> a -> a
Control.Exception.assert (
	Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> IsShort
forall a. Eq a => a -> a -> IsShort
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King IsShort -> IsShort -> IsShort
&& IsShort -> (Rank -> IsShort) -> Maybe Rank -> IsShort
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsShort
True {-nothing promoted-} (
		Rank -> [Rank] -> IsShort
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsShort
`elem` [Rank]
Attribute.Rank.promotionProspects
	) Maybe Rank
maybePromotionRank
 ) (MoveType -> MoveType) -> MoveType -> MoveType
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Normal Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank

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

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

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

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

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

-- | <https://www.chessprogramming.org/Quiet_Moves>.
isQuiet :: MoveType -> Bool
isQuiet :: MoveType -> IsShort
isQuiet (Normal Maybe Rank
Nothing Maybe Rank
Nothing)	= IsShort
True
isQuiet	MoveType
moveType			= MoveType -> IsShort
isCastle MoveType
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 :: MoveType -> IsShort
isAcyclic (Normal Maybe Rank
Nothing Maybe Rank
Nothing)	= IsShort
False
isAcyclic MoveType
_				= IsShort
True

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

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

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