module BishBosh.Attribute.Rank(
Promotable(..),
EvaluateRank,
ByRank,
Rank(..),
tag,
flank,
promotionProspects,
defaultPromotionRank,
plodders,
fixedAttackRange,
individuallySufficientMaterial,
pieces,
nobility,
range,
expendable,
nDistinctRanks,
compareByLVA,
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
tag :: String
tag = "rank"
data Rank
= Pawn
| Rook
| Knight
| Bishop
| Queen
| King
deriving (
Bounded,
Enum,
Eq,
Ord
)
instance Control.DeepSeq.NFData Rank where
rnf _ = ()
instance Data.Array.IArray.Ix Rank where
range (lower, upper) = Control.Exception.assert (lower == minBound && upper == maxBound) range
inRange (lower, upper) rank = Control.Exception.assert (rank >= lower && rank <= upper) True
index (lower, upper) = Control.Exception.assert (lower == minBound && upper == maxBound) . fromEnum
instance Show Rank where
showsPrec _ rank = showChar $ case rank of
Pawn -> 'p'
Rook -> 'r'
Knight -> 'n'
Bishop -> 'b'
Queen -> 'q'
King -> 'k'
instance Read Rank where
readsPrec _ (c : s)
| Data.Char.isSpace c = reads s
| otherwise = map (flip (,) s) $ case Data.Char.toLower c of
'p' -> [Pawn]
'r' -> [Rook]
'n' -> [Knight]
'b' -> [Bishop]
'q' -> [Queen]
'k' -> [King]
_ -> []
readsPrec _ _ = []
instance HXT.XmlPickler Rank where
xpickle = HXT.xpAttr tag . HXT.xpWrap (read, show) . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range
flank :: [Rank]
flank = [Rook, Knight, Bishop]
promotionProspects :: [Rank]
promotionProspects = Queen : flank
defaultPromotionRank :: Rank
defaultPromotionRank = Queen
plodders :: [Rank]
plodders = [Pawn, King]
fixedAttackRange :: [Rank]
fixedAttackRange = Knight : plodders
individuallySufficientMaterial :: [Rank]
individuallySufficientMaterial = [Pawn, Rook, Queen]
royalty :: [Rank]
royalty = [Queen, King]
pieces :: [Rank]
pieces = flank ++ royalty
nobility :: [Rank]
nobility = pieces ++ reverse flank
range :: [Rank]
range = [minBound .. maxBound]
expendable :: [Rank]
expendable = Data.List.delete King range
type EvaluateRank rankValue = Rank -> rankValue
compareByLVA
:: Ord rankValue
=> EvaluateRank rankValue
-> Rank
-> Rank
-> Ordering
compareByLVA evaluateRank rankL rankR
| rankL == rankR = EQ
| rankL == King = GT
| rankR == King = LT
| otherwise = Data.Ord.comparing evaluateRank rankL rankR
type NRanks = Int
nDistinctRanks :: NRanks
nDistinctRanks = length range
type ByRank = Data.Array.IArray.Array Rank
listArrayByRank :: Data.Array.IArray.IArray a e => [e] -> a Rank e
listArrayByRank = Data.Array.IArray.listArray (minBound, maxBound)
class Promotable a where
getMaybePromotionRank :: a -> Maybe Rank