{-
	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     = "rank"

-- | The component of a chess-/piece/ which is independent of its colour.
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				= uncurry enumFromTo
	inRange (lower, upper) rank	= rank >= lower && rank <= upper
	index (lower, _) rank		= fromEnum rank - fromEnum lower
-}
        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       -- Consume.
                | otherwise             = map (flip (,) s) $ case Data.Char.toLower c of
                        'p'     -> [Pawn]
                        'r'     -> [Rook]
                        'n'     -> [Knight]
                        'b'     -> [Bishop]
                        'q'     -> [Queen]
                        'k'     -> [King]
                        _       -> []   -- No parse.
        readsPrec _ _   = []    -- No parse.

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

-- | The distinct /rank/s of the constant ordered range of those /piece/s of which each side has exactly two.
flank :: [Rank]
flank   = [Rook, Knight, 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      = Queen : flank

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

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

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

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

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

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

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

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

-- | Those /rank/s which can be taken.
expendable :: [Rank]
expendable      = Data.List.delete King 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 rankL rankR
        | rankL == rankR        = EQ
        | rankL == King         = GT
        | rankR == King         = LT
        | otherwise             = Data.Ord.comparing evaluateRank rankL rankR

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

-- | The constant number of distinct /rank/s.
nDistinctRanks :: NRanks
nDistinctRanks  = length 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 = Data.Array.IArray.listArray (minBound, maxBound)

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