{-
	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,
--	NRanks,
	ByRank,
-- ** Data-types
	Rank(..),
-- * Constants
	tag,
	flank,
	promotionProspects,
	defaultPromotionRank,
	plodders,
	fixedAttackRange,
	individuallySufficientMaterial,
--	royalty
	pieces,
	nobility,
	range,
	expendable,
	nDistinctRanks,
-- * Functions
	compareByLVA,
-- ** Constructor
	listArrayByRank
) where

import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Char
import qualified	Data.List
import qualified	Data.Ord
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"

-- | The component of a chess-/piece/ which is independent of 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
	showsPrec :: Int -> Rank -> ShowS
showsPrec Int
_ Rank
rank	= Char -> ShowS
showChar (Char -> ShowS) -> Char -> ShowS
forall a b. (a -> b) -> a -> b
$ case Rank
rank of
		Rank
Pawn	-> Char
'p'
		Rank
Rook	-> Char
'r'
		Rank
Knight	-> Char
'n'
		Rank
Bishop	-> Char
'b'
		Rank
Queen	-> Char
'q'
		Rank
King	-> Char
'k'

instance Read Rank where
	readsPrec :: Int -> ReadS Rank
readsPrec Int
_ (Char
c : String
s)
		| Char -> Bool
Data.Char.isSpace Char
c	= ReadS Rank
forall a. Read a => ReadS a
reads 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 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

-- | 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]

-- | 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 rankValue	= Rank -> 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
	:: Ord rankValue
	=> EvaluateRank rankValue
	-> Rank
	-> Rank
	-> Ordering
compareByLVA :: EvaluateRank rankValue -> Rank -> Rank -> Ordering
compareByLVA EvaluateRank rankValue
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 rankValue -> Rank -> Rank -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing EvaluateRank rankValue
evaluateRank Rank
rankL Rank
rankR

-- | A number of ranks.
type NRanks	= Int

-- | The constant number of distinct /rank/s.
nDistinctRanks :: NRanks
nDistinctRanks :: Int
nDistinctRanks	= [Rank] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rank]
range

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

-- | An array-constructor.
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)

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