{-
	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@]	Defines the data-type which represents the rank of a chess-/piece/.

 [@CAVEAT@]	This term is also commonly used to refer to a row of the board.
-}

module BishBosh.Attribute.Rank(
-- * Type-classes
	Promotable(..),
-- * Types
-- ** Type-synonyms
	EvaluateRank,
	ArrayByRank,
	UArrayByRank,
-- ** Data-types
	Rank(..),
-- * Constants
	tag,
	flank,
	promotionProspects,
	defaultPromotionRank,
	plodders,
	fixedAttackRange,
	individuallySufficientMaterial,
--	royalty
	pieces,
	nobility,
	range,
	earthBound,
	expendable,
	nDistinctRanks,
	initialAllocationByRankPerSide,
-- * Functions
	compareByLVA,
	findUndefinedRanks,
-- ** Constructor
	listArrayByRank,
	arrayByRank
) where

import qualified	BishBosh.Metric.RankValue		as Metric.RankValue
import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Array.Unboxed
import qualified	Data.Char
import qualified	Data.List
import qualified	Data.Ord
import qualified	Data.Set
import qualified	Text.XML.HXT.Arrow.Pickle		as HXT
import qualified	Text.XML.HXT.Arrow.Pickle.Schema

-- | Used to qualify XML.
tag :: String
tag :: String
tag	= String
"rank"

-- | A sum-type which represents the component of a chess-/piece/ other than its colour.
data Rank
	= Pawn
	| Rook
	| Knight
	| Bishop
	| Queen
	| King
	deriving (
		Rank
Rank -> Rank -> Bounded Rank
forall a. a -> a -> Bounded a
maxBound :: Rank
$cmaxBound :: Rank
minBound :: Rank
$cminBound :: Rank
Bounded,
		Int -> Rank
Rank -> Int
Rank -> [Rank]
Rank -> Rank
Rank -> Rank -> [Rank]
Rank -> Rank -> Rank -> [Rank]
(Rank -> Rank)
-> (Rank -> Rank)
-> (Int -> Rank)
-> (Rank -> Int)
-> (Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> [Rank])
-> (Rank -> Rank -> Rank -> [Rank])
-> Enum Rank
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
$cenumFromThenTo :: Rank -> Rank -> Rank -> [Rank]
enumFromTo :: Rank -> Rank -> [Rank]
$cenumFromTo :: Rank -> Rank -> [Rank]
enumFromThen :: Rank -> Rank -> [Rank]
$cenumFromThen :: Rank -> Rank -> [Rank]
enumFrom :: Rank -> [Rank]
$cenumFrom :: Rank -> [Rank]
fromEnum :: Rank -> Int
$cfromEnum :: Rank -> Int
toEnum :: Int -> Rank
$ctoEnum :: Int -> Rank
pred :: Rank -> Rank
$cpred :: Rank -> Rank
succ :: Rank -> Rank
$csucc :: Rank -> Rank
Enum,
		Rank -> Rank -> Bool
(Rank -> Rank -> Bool) -> (Rank -> Rank -> Bool) -> Eq Rank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rank -> Rank -> Bool
$c/= :: Rank -> Rank -> Bool
== :: Rank -> Rank -> Bool
$c== :: Rank -> Rank -> Bool
Eq,
		Eq Rank
Eq Rank
-> (Rank -> Rank -> Ordering)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Bool)
-> (Rank -> Rank -> Rank)
-> (Rank -> Rank -> Rank)
-> Ord Rank
Rank -> Rank -> Bool
Rank -> Rank -> Ordering
Rank -> Rank -> Rank
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Rank -> Rank -> Rank
$cmin :: Rank -> Rank -> Rank
max :: Rank -> Rank -> Rank
$cmax :: Rank -> Rank -> Rank
>= :: Rank -> Rank -> Bool
$c>= :: Rank -> Rank -> Bool
> :: Rank -> Rank -> Bool
$c> :: Rank -> Rank -> Bool
<= :: Rank -> Rank -> Bool
$c<= :: Rank -> Rank -> Bool
< :: Rank -> Rank -> Bool
$c< :: Rank -> Rank -> Bool
compare :: Rank -> Rank -> Ordering
$ccompare :: Rank -> Rank -> Ordering
$cp1Ord :: Eq Rank
Ord
	)

instance Control.DeepSeq.NFData Rank where
	rnf :: Rank -> ()
rnf Rank
_	= ()

instance Data.Array.IArray.Ix Rank where
{-
	range				= uncurry enumFromTo
	inRange (lower, upper) rank	= rank >= lower && rank <= upper
	index (lower, _) rank		= fromEnum rank - fromEnum lower
-}
	range :: (Rank, Rank) -> [Rank]
range (Rank
lower, Rank
upper)		= Bool -> [Rank] -> [Rank]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Rank
lower Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Rank
upper Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
forall a. Bounded a => a
maxBound) [Rank]
range
	inRange :: (Rank, Rank) -> Rank -> Bool
inRange (Rank
lower, Rank
upper) Rank
rank	= Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Rank
rank Rank -> Rank -> Bool
forall a. Ord a => a -> a -> Bool
>= Rank
lower Bool -> Bool -> Bool
&& Rank
rank Rank -> Rank -> Bool
forall a. Ord a => a -> a -> Bool
<= Rank
upper) Bool
True
	index :: (Rank, Rank) -> Rank -> Int
index (Rank
lower, Rank
upper)		= Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Rank
lower Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Rank
upper Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
forall a. Bounded a => a
maxBound) (Int -> Int) -> (Rank -> Int) -> Rank -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> Int
forall a. Enum a => a -> Int
fromEnum

instance Show Rank where
	show :: Rank -> String
show Rank
Pawn	= String
"p"
	show Rank
Rook	= String
"r"
	show Rank
Knight	= String
"n"
	show Rank
Bishop	= String
"b"
	show Rank
Queen	= String
"q"
	show Rank
King	= String
"k"

instance Read Rank where
	readsPrec :: Int -> ReadS Rank
readsPrec Int
precedence (Char
c : String
s)
		| Char -> Bool
Data.Char.isSpace Char
c	= Int -> ReadS Rank
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence String
s	-- Consume.
		| Bool
otherwise		= (Rank -> (Rank, String)) -> [Rank] -> [(Rank, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rank -> String -> (Rank, String))
-> String -> Rank -> (Rank, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) String
s) ([Rank] -> [(Rank, String)]) -> [Rank] -> [(Rank, String)]
forall a b. (a -> b) -> a -> b
$ case Char -> Char
Data.Char.toLower Char
c of
			Char
'p'	-> [Rank
Pawn]
			Char
'r'	-> [Rank
Rook]
			Char
'n'	-> [Rank
Knight]
			Char
'b'	-> [Rank
Bishop]
			Char
'q'	-> [Rank
Queen]
			Char
'k'	-> [Rank
King]
			Char
_	-> []	-- No parse.
	readsPrec Int
_ String
_	= []	-- No parse.

instance HXT.XmlPickler Rank where
	xpickle :: PU Rank
xpickle	= String -> PU Rank -> PU Rank
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU Rank -> PU Rank)
-> ([String] -> PU Rank) -> [String] -> PU Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Rank, Rank -> String) -> PU String -> PU Rank
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> Rank
forall a. Read a => String -> a
read, Rank -> String
forall a. Show a => a -> String
show) (PU String -> PU Rank)
-> ([String] -> PU String) -> [String] -> PU Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU Rank) -> [String] -> PU Rank
forall a b. (a -> b) -> a -> b
$ (Rank -> String) -> [Rank] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Rank -> String
forall a. Show a => a -> String
show [Rank]
range

-- | The constant ascending list of all /rank/s.
range :: [Rank]
range :: [Rank]
range	= [Rank
forall a. Bounded a => a
minBound .. Rank
forall a. Bounded a => a
maxBound]

instance Property.FixedMembership.FixedMembership Rank where
	members :: [Rank]
members	= [Rank]
range

-- | The distinct /rank/s of the constant ordered range of those /piece/s of which each side has exactly two.
flank :: [Rank]
flank :: [Rank]
flank	= [Rank
Rook, Rank
Knight, Rank
Bishop]

-- | The constant list of distinct /rank/ to which a @Pawn@ may legally be promoted; though there's no point in promotion to other than @Queen@ or @Knight@.
promotionProspects :: [Rank]
promotionProspects :: [Rank]
promotionProspects	= Rank
Queen Rank -> [Rank] -> [Rank]
forall a. a -> [a] -> [a]
: [Rank]
flank

-- | The /rank/ to which a @Pawn@ is, in the absence of instruction, promoted.
defaultPromotionRank :: Rank
defaultPromotionRank :: Rank
defaultPromotionRank	= Rank
Queen

-- | The subset of /rank/s which can only move in single steps.
plodders :: [Rank]
plodders :: [Rank]
plodders	= [Rank
Pawn, Rank
King]

-- | The subset of /rank/s which attack over a fixed range.
fixedAttackRange :: [Rank]
fixedAttackRange :: [Rank]
fixedAttackRange	= Rank
Knight Rank -> [Rank] -> [Rank]
forall a. a -> [a] -> [a]
: [Rank]
plodders

-- | The subset of /rank/s which lacking support, are sufficient to force checkmate.
individuallySufficientMaterial :: [Rank]
individuallySufficientMaterial :: [Rank]
individuallySufficientMaterial	= [Rank
Pawn, Rank
Rook, Rank
Queen]

-- | The /rank/s of the back row of pieces, excluding both flanks.
royalty :: [Rank]
royalty :: [Rank]
royalty	= [Rank
Queen, Rank
King]

-- | The distinct /rank/s of the pieces from which the back row is composed, i.e. everything except @Pawn@s.
pieces :: [Rank]
pieces :: [Rank]
pieces	= [Rank]
flank [Rank] -> [Rank] -> [Rank]
forall a. [a] -> [a] -> [a]
++ [Rank]
royalty

-- | The ordered /rank/s of the pieces from which the back row is composed, including duplicates.
nobility :: [Rank]
nobility :: [Rank]
nobility	= [Rank]
pieces [Rank] -> [Rank] -> [Rank]
forall a. [a] -> [a] -> [a]
++ [Rank] -> [Rank]
forall a. [a] -> [a]
reverse [Rank]
flank

-- | Those /rank/s which can't jump.
earthBound :: [Rank]
earthBound :: [Rank]
earthBound	= Rank -> [Rank] -> [Rank]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Rank
Knight [Rank]
range

-- | Those /rank/s which can be taken.
expendable :: [Rank]
expendable :: [Rank]
expendable	= Rank -> [Rank] -> [Rank]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Rank
King [Rank]
range

-- | The type of a function which returns a /rank/'s value.
type EvaluateRank	= Rank -> Metric.RankValue.RankValue

{- |
	* Given two alternative capture moves, this function compares the rank-value of the aggressors.

	* N.B.: a @King@ is always considered most valuable, regardless of the evaluation-function supplied.
-}
compareByLVA
	:: EvaluateRank
	-> Rank
	-> Rank
	-> Ordering
compareByLVA :: EvaluateRank -> Rank -> Rank -> Ordering
compareByLVA EvaluateRank
evaluateRank Rank
rankL Rank
rankR
	| Rank
rankL Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
rankR	= Ordering
EQ
	| Rank
rankL Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
King		= Ordering
GT
	| Rank
rankR Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
King		= Ordering
LT
	| Bool
otherwise		= EvaluateRank -> Rank -> Rank -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing EvaluateRank
evaluateRank Rank
rankL Rank
rankR

-- | The constant number of distinct /rank/s.
nDistinctRanks :: Type.Count.NRanks
nDistinctRanks :: Int
nDistinctRanks	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Rank] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rank]
range

-- | The constant number of each rank per side, at the conventional opening position.
initialAllocationByRankPerSide :: ArrayByRank Type.Count.NPieces
initialAllocationByRankPerSide :: ArrayByRank Int
initialAllocationByRankPerSide	= [Int] -> ArrayByRank Int
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
listArrayByRank [Int
8, Int
2, Int
2, Int
2, Int
1, Int
1]

-- | A boxed array indexed by /rank/, of arbitrary values.
type ArrayByRank	= Data.Array.IArray.Array Rank

-- | An unboxed array indexed by /rank/, of fixed-size values.
type UArrayByRank	= Data.Array.Unboxed.UArray Rank

-- | Array-constructor from an ordered list of elements.
listArrayByRank :: Data.Array.IArray.IArray a e => [e] -> a Rank e
listArrayByRank :: [e] -> a Rank e
listArrayByRank	= (Rank, Rank) -> [e] -> a Rank e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Rank
forall a. Bounded a => a
minBound, Rank
forall a. Bounded a => a
maxBound)

-- | Array-constructor from an association-list.
arrayByRank :: Data.Array.IArray.IArray a e => [(Rank, e)] -> a Rank e
arrayByRank :: [(Rank, e)] -> a Rank e
arrayByRank	= (Rank, Rank) -> [(Rank, e)] -> a Rank e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
Data.Array.IArray.array (Rank
forall a. Bounded a => a
minBound, Rank
forall a. Bounded a => a
maxBound)

-- | An interface which data which can represent @Pawn@-promotion, can implement.
class Promotable a where
	getMaybePromotionRank	:: a -> Maybe Rank

-- | Finds any unspecified ranks.
findUndefinedRanks :: [Rank] -> [Rank]
findUndefinedRanks :: [Rank] -> [Rank]
findUndefinedRanks	= Set Rank -> [Rank]
forall a. Set a -> [a]
Data.Set.toList (Set Rank -> [Rank]) -> ([Rank] -> Set Rank) -> [Rank] -> [Rank]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rank] -> Set Rank
forall a. Eq a => [a] -> Set a
Data.Set.fromAscList [Rank]
range Set Rank -> Set Rank -> Set Rank
forall a. Ord a => Set a -> Set a -> Set a
`Data.Set.difference`) (Set Rank -> Set Rank)
-> ([Rank] -> Set Rank) -> [Rank] -> Set Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rank] -> Set Rank
forall a. Ord a => [a] -> Set a
Data.Set.fromList