{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module BishBosh.State.Board(
NBoards,
Board(
getMaybePieceByCoordinates,
getCoordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour,
getNPiecesDifferenceByRank,
getNPawnsByFileByLogicalColour,
getNPieces,
getPassedPawnCoordinatesByLogicalColour
),
countDefendersByCoordinatesByLogicalColour,
summariseNDefendersByLogicalColour,
findProximateKnights,
sumPieceSquareValueByLogicalColour,
findAttackersOf,
findAttacksBy,
movePiece,
defineCoordinates,
placePiece,
removePiece,
isKingChecked,
exposesKing
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!), (//))
import qualified BishBosh.Attribute.Direction as Attribute.Direction
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.Piece as Component.Piece
import qualified BishBosh.Component.PieceSquareArray as Component.PieceSquareArray
import qualified BishBosh.Component.Zobrist as Component.Zobrist
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.State.Censor as State.Censor
import qualified BishBosh.State.CoordinatesByRankByLogicalColour as State.CoordinatesByRankByLogicalColour
import qualified BishBosh.State.MaybePieceByCoordinates as State.MaybePieceByCoordinates
import qualified BishBosh.Types as T
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.List
import qualified Data.Map
import qualified Data.Maybe
import qualified ToolShed.Data.List
type Transformation x y = Board x y -> Board x y
type NDefendersByCoordinatesByLogicalColour x y = Attribute.LogicalColour.ByLogicalColour (Data.Map.Map (Cartesian.Coordinates.Coordinates x y) Component.Piece.NPieces)
type NBoards = Int
data Board x y = MkBoard {
getMaybePieceByCoordinates :: State.MaybePieceByCoordinates.MaybePieceByCoordinates x y,
getCoordinatesByRankByLogicalColour :: State.CoordinatesByRankByLogicalColour.CoordinatesByRankByLogicalColour x y,
getNDefendersByCoordinatesByLogicalColour :: NDefendersByCoordinatesByLogicalColour x y,
getNPiecesDifferenceByRank :: State.Censor.NPiecesByRank,
getNPawnsByFileByLogicalColour :: State.CoordinatesByRankByLogicalColour.NPiecesByFileByLogicalColour x,
getNPieces :: Component.Piece.NPieces,
getPassedPawnCoordinatesByLogicalColour :: State.CoordinatesByRankByLogicalColour.CoordinatesByLogicalColour x y
}
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Eq (Board x y) where
MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates } == MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates' } = maybePieceByCoordinates == maybePieceByCoordinates'
instance (
Control.DeepSeq.NFData x,
Control.DeepSeq.NFData y
) => Control.DeepSeq.NFData (Board x y) where
rnf MkBoard {
getMaybePieceByCoordinates = maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour = nDefendersByCoordinatesByLogicalColour,
getNPawnsByFileByLogicalColour = nPawnsByFileByLogicalColour,
getNPieces = nPieces,
getPassedPawnCoordinatesByLogicalColour = passedPawnCoordinatesByLogicalColour
} = Control.DeepSeq.rnf (
maybePieceByCoordinates,
coordinatesByRankByLogicalColour,
nDefendersByCoordinatesByLogicalColour,
nPawnsByFileByLogicalColour,
nPieces,
passedPawnCoordinatesByLogicalColour
)
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Read (Board x y) where
{-# SPECIALISE instance Read (Board T.X T.Y) #-}
readsPrec _ = Property.ForsythEdwards.readsFEN
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Show (Board x y) where
showsPrec _ = Property.ForsythEdwards.showsFEN
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.ForsythEdwards.ReadsFEN (Board x y) where
{-# SPECIALISE instance Property.ForsythEdwards.ReadsFEN (Board T.X T.Y) #-}
readsFEN = map (Control.Arrow.first fromMaybePieceByCoordinates) . Property.ForsythEdwards.readsFEN
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.ForsythEdwards.ShowsFEN (Board x y) where
showsFEN MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates } = Property.ForsythEdwards.showsFEN maybePieceByCoordinates
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Data.Default.Default (Board x y) where
{-# SPECIALISE instance Data.Default.Default (Board T.X T.Y) #-}
def = fromMaybePieceByCoordinates Data.Default.def
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.Reflectable.ReflectableOnX (Board x y) where
{-# SPECIALISE instance Property.Reflectable.ReflectableOnX (Board T.X T.Y) #-}
reflectOnX MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates } = fromMaybePieceByCoordinates $ Property.Reflectable.reflectOnX maybePieceByCoordinates
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.Reflectable.ReflectableOnY (Board x y) where
{-# SPECIALISE instance Property.Reflectable.ReflectableOnY (Board T.X T.Y) #-}
reflectOnY MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates } = fromMaybePieceByCoordinates $ Property.Reflectable.reflectOnY maybePieceByCoordinates
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.Empty.Empty (Board x y) where
{-# SPECIALISE empty :: Board T.X T.Y #-}
empty = fromMaybePieceByCoordinates Property.Empty.empty
instance (Enum x, Enum y, Ord x, Ord y) => Component.Zobrist.Hashable2D Board x y where
listRandoms2D MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour } = Component.Zobrist.listRandoms2D coordinatesByRankByLogicalColour
fromMaybePieceByCoordinates :: (
Enum x,
Enum y,
Ord x,
Ord y
) => State.MaybePieceByCoordinates.MaybePieceByCoordinates x y -> Board x y
{-# SPECIALISE fromMaybePieceByCoordinates :: State.MaybePieceByCoordinates.MaybePieceByCoordinates T.X T.Y -> Board T.X T.Y #-}
fromMaybePieceByCoordinates maybePieceByCoordinates = board where
board@MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour } = MkBoard {
getMaybePieceByCoordinates = maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour = State.CoordinatesByRankByLogicalColour.fromMaybePieceByCoordinates maybePieceByCoordinates,
getNDefendersByCoordinatesByLogicalColour = countDefendersByCoordinatesByLogicalColour board,
getNPiecesDifferenceByRank = State.Censor.countPieceDifferenceByRank coordinatesByRankByLogicalColour,
getNPawnsByFileByLogicalColour = State.CoordinatesByRankByLogicalColour.countPawnsByFileByLogicalColour coordinatesByRankByLogicalColour,
getNPieces = State.Censor.countPieces coordinatesByRankByLogicalColour,
getPassedPawnCoordinatesByLogicalColour = State.CoordinatesByRankByLogicalColour.findPassedPawnCoordinatesByLogicalColour coordinatesByRankByLogicalColour
}
movePiece :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> Component.Move.Move x y
-> Maybe Attribute.MoveType.MoveType
-> Transformation x y
{-# SPECIALISE movePiece :: Component.Move.Move T.X T.Y -> Maybe Attribute.MoveType.MoveType -> Transformation T.X T.Y #-}
movePiece move maybeMoveType board@MkBoard {
getMaybePieceByCoordinates = maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour = nDefendersByCoordinatesByLogicalColour,
getNPiecesDifferenceByRank = nPiecesDifferenceByRank,
getNPieces = nPieces
}
| Just sourcePiece <- State.MaybePieceByCoordinates.dereference source maybePieceByCoordinates = let
logicalColour = Component.Piece.getLogicalColour sourcePiece
moveType :: Attribute.MoveType.MoveType
moveType
| Just explicitMoveType <- maybeMoveType = explicitMoveType
| State.MaybePieceByCoordinates.isEnPassantMove move maybePieceByCoordinates = Attribute.MoveType.enPassant
| otherwise = Attribute.MoveType.mkNormalMoveType (
Component.Piece.getRank `fmap` State.MaybePieceByCoordinates.dereference destination maybePieceByCoordinates
) $ if Component.Piece.isPawnPromotion destination sourcePiece
then Just Attribute.Rank.defaultPromotionRank
else Nothing
eitherPassingPawnsDestinationOrMaybeTakenRank
| Attribute.MoveType.isEnPassant moveType = Left $ Cartesian.Coordinates.retreat logicalColour destination
| otherwise = Right $ Attribute.MoveType.getMaybeExplicitlyTakenRank moveType
maybePromotionRank :: Maybe Attribute.Rank.Rank
maybePromotionRank = Attribute.Rank.getMaybePromotionRank moveType
destinationPiece :: Component.Piece.Piece
destinationPiece = Data.Maybe.maybe id Component.Piece.promote maybePromotionRank sourcePiece
board'@MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates' } = MkBoard {
getMaybePieceByCoordinates = State.MaybePieceByCoordinates.movePiece move destinationPiece (
either Just (const Nothing) eitherPassingPawnsDestinationOrMaybeTakenRank
) maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour = State.CoordinatesByRankByLogicalColour.movePiece move sourcePiece maybePromotionRank eitherPassingPawnsDestinationOrMaybeTakenRank coordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour = let
oppositePiece = Property.Opposable.getOpposite sourcePiece
opponentsLogicalColour = Component.Piece.getLogicalColour oppositePiece
eitherPassingPawnsDestinationOrMaybeTakenPiece = fmap (Component.Piece.mkPiece opponentsLogicalColour) `fmap` eitherPassingPawnsDestinationOrMaybeTakenRank
in (
\(nBlackDefendersByCoordinates, nWhiteDefendersByCoordinates) -> Attribute.LogicalColour.listArrayByLogicalColour [nBlackDefendersByCoordinates, nWhiteDefendersByCoordinates]
) . foldr (
\(affectedCoordinates, affectedPiece) -> if Component.Piece.isKing affectedPiece
then id
else let
logicalColour' = Component.Piece.getLogicalColour affectedPiece
in (
if Attribute.LogicalColour.isBlack logicalColour'
then Control.Arrow.first
else Control.Arrow.second
) . Data.Map.insert affectedCoordinates . length $ findAttackersOf (
Property.Opposable.getOpposite logicalColour'
) affectedCoordinates board'
) (
(! Attribute.LogicalColour.Black) &&& (! Attribute.LogicalColour.White) $ nDefendersByCoordinatesByLogicalColour // (
let
nDefendersByCoordinates = nDefendersByCoordinatesByLogicalColour ! opponentsLogicalColour
in either (
\passingPawnsDestination -> (:) (
opponentsLogicalColour,
Data.Map.delete passingPawnsDestination nDefendersByCoordinates
)
) (
\maybeExplicitlyTakenRank -> if Data.Maybe.isJust maybeExplicitlyTakenRank
then (:) (
opponentsLogicalColour,
Data.Map.delete destination nDefendersByCoordinates
)
else id
) eitherPassingPawnsDestinationOrMaybeTakenRank
) [
(
logicalColour,
Data.Map.delete source $ nDefendersByCoordinatesByLogicalColour ! logicalColour
)
]
) . Data.List.nubBy (
ToolShed.Data.List.equalityBy fst
) $ [
(affectedCoordinates, affectedPiece) |
(knightsCoordinates, knight) <- (source, sourcePiece) : map ((,) destination) (destinationPiece : either (const []) Data.Maybe.maybeToList eitherPassingPawnsDestinationOrMaybeTakenPiece),
Component.Piece.isKnight knight,
Just affectedCoordinates <- Cartesian.Vector.maybeTranslate knightsCoordinates `map` (Cartesian.Vector.attackVectorsForKnight :: [Cartesian.Vector.VectorInt]),
affectedPiece <- Data.Maybe.maybeToList $ State.MaybePieceByCoordinates.dereference affectedCoordinates maybePieceByCoordinates',
Component.Piece.isFriend knight affectedPiece
] ++ [
(blockingCoordinates, blockingPiece) |
passingPawnsDestination <- either return (const []) eitherPassingPawnsDestinationOrMaybeTakenRank,
(direction, antiParallelDirection) <- Attribute.Direction.opposites,
(blockingCoordinates, blockingPiece) <- case ($ direction) &&& ($ antiParallelDirection) $ ($ maybePieceByCoordinates') . (`State.MaybePieceByCoordinates.findBlockingPiece` passingPawnsDestination) of
(Just cp, Just cp') -> [
cp |
let isDefendedBy from = uncurry (&&) . uncurry (&&&) (Component.Piece.canAttackAlong from *** Component.Piece.isFriend $ cp),
isDefendedBy passingPawnsDestination oppositePiece || uncurry isDefendedBy cp'
] ++ [
cp' |
let isDefendedBy from = uncurry (&&) . uncurry (&&&) (Component.Piece.canAttackAlong from *** Component.Piece.isFriend $ cp'),
isDefendedBy passingPawnsDestination oppositePiece || uncurry isDefendedBy cp
]
(Just cp, _) -> [
cp |
uncurry (&&) $ uncurry (&&&) (Component.Piece.canAttackAlong passingPawnsDestination *** Component.Piece.isFriend $ cp) oppositePiece
]
(_, Just cp') -> [
cp' |
uncurry (&&) $ uncurry (&&&) (Component.Piece.canAttackAlong passingPawnsDestination *** Component.Piece.isFriend $ cp') oppositePiece
]
_ -> []
] ++ (destination, destinationPiece) : [
(blockingCoordinates, blockingPiece) |
let maybeExplicitlyTakenPiece = either (const Nothing) id eitherPassingPawnsDestinationOrMaybeTakenPiece,
(direction, antiParallelDirection) <- Attribute.Direction.opposites,
(coordinates, piece) <- [(source, sourcePiece), (destination, destinationPiece)],
(blockingCoordinates, blockingPiece) <- case ($ direction) &&& ($ antiParallelDirection) $ ($ maybePieceByCoordinates') . (`State.MaybePieceByCoordinates.findBlockingPiece` coordinates) of
(Just cp, Just cp') -> [
cp |
let isDefendedBy from = uncurry (&&) . uncurry (&&&) (Component.Piece.canAttackAlong from *** Component.Piece.isFriend $ cp),
isDefendedBy coordinates piece || coordinates == destination && Data.Maybe.maybe False (isDefendedBy destination) maybeExplicitlyTakenPiece || uncurry isDefendedBy cp'
] ++ [
cp' |
let isDefendedBy from = uncurry (&&) . uncurry (&&&) (Component.Piece.canAttackAlong from *** Component.Piece.isFriend $ cp'),
isDefendedBy coordinates piece || coordinates == destination && Data.Maybe.maybe False (isDefendedBy destination) maybeExplicitlyTakenPiece || uncurry isDefendedBy cp
]
(Just cp, _) -> [
cp |
let isDefendedBy = uncurry (&&) . uncurry (&&&) (Component.Piece.canAttackAlong coordinates *** Component.Piece.isFriend $ cp),
isDefendedBy piece || coordinates == destination && Data.Maybe.maybe False isDefendedBy maybeExplicitlyTakenPiece
]
(_, Just cp') -> [
cp' |
let isDefendedBy = uncurry (&&) . uncurry (&&&) (Component.Piece.canAttackAlong coordinates *** Component.Piece.isFriend $ cp'),
isDefendedBy piece || coordinates == destination && Data.Maybe.maybe False isDefendedBy maybeExplicitlyTakenPiece
]
_ -> []
],
getNPiecesDifferenceByRank = Data.Array.IArray.accum (
if Attribute.LogicalColour.isBlack logicalColour
then (-)
else (+)
) nPiecesDifferenceByRank $ if Attribute.MoveType.isEnPassant moveType
then [(Attribute.Rank.Pawn, 1)]
else Data.Maybe.maybe id (
(:) . flip (,) 1
) (
Attribute.MoveType.getMaybeExplicitlyTakenRank moveType
) $ Data.Maybe.maybe [] (
\promotionRank -> [
(
promotionRank,
1
), (
Attribute.Rank.Pawn,
negate 1
)
]
) maybePromotionRank,
getNPawnsByFileByLogicalColour = if Component.Piece.isPawn sourcePiece && (
Cartesian.Coordinates.getX source /= Cartesian.Coordinates.getX destination || Attribute.MoveType.isPromotion moveType
) || Data.Maybe.maybe False (== Attribute.Rank.Pawn) (Attribute.MoveType.getMaybeExplicitlyTakenRank moveType)
then State.CoordinatesByRankByLogicalColour.countPawnsByFileByLogicalColour coordinatesByRankByLogicalColour'
else getNPawnsByFileByLogicalColour board,
getNPieces = Attribute.MoveType.nPiecesMutator moveType nPieces,
getPassedPawnCoordinatesByLogicalColour = if Component.Piece.isPawn sourcePiece || Data.Maybe.maybe False (== Attribute.Rank.Pawn) (Attribute.MoveType.getMaybeExplicitlyTakenRank moveType)
then State.CoordinatesByRankByLogicalColour.findPassedPawnCoordinatesByLogicalColour coordinatesByRankByLogicalColour'
else getPassedPawnCoordinatesByLogicalColour board
}
coordinatesByRankByLogicalColour' = getCoordinatesByRankByLogicalColour board'
in board'
| otherwise = Control.Exception.throw . Data.Exception.mkSearchFailure . showString "BishBosh.State.Board.movePiece:\tno piece exists at " . shows source . showString "; " $ shows board "."
where
(source, destination) = Component.Move.getSource &&& Component.Move.getDestination $ move
defineCoordinates :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Maybe Component.Piece.Piece
-> Cartesian.Coordinates.Coordinates x y
-> Transformation x y
{-# SPECIALISE defineCoordinates :: Maybe Component.Piece.Piece -> Cartesian.Coordinates.Coordinates T.X T.Y -> Transformation T.X T.Y #-}
defineCoordinates maybePiece coordinates MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates } = fromMaybePieceByCoordinates $ State.MaybePieceByCoordinates.defineCoordinates maybePiece coordinates maybePieceByCoordinates
placePiece :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Component.Piece.Piece
-> Cartesian.Coordinates.Coordinates x y
-> Transformation x y
{-# SPECIALISE placePiece :: Component.Piece.Piece -> Cartesian.Coordinates.Coordinates T.X T.Y -> Transformation T.X T.Y #-}
placePiece piece coordinates board = Control.Exception.assert (
State.MaybePieceByCoordinates.isVacant coordinates $ getMaybePieceByCoordinates board
) $ defineCoordinates (Just piece) coordinates board
removePiece :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Cartesian.Coordinates.Coordinates x y -> Transformation x y
{-# SPECIALISE removePiece :: Cartesian.Coordinates.Coordinates T.X T.Y -> Transformation T.X T.Y #-}
removePiece coordinates board = Control.Exception.assert (
State.MaybePieceByCoordinates.isOccupied coordinates $ getMaybePieceByCoordinates board
) $ defineCoordinates Nothing coordinates board
findProximateKnights :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates x y
-> Board x y
-> [Cartesian.Coordinates.Coordinates x y]
{-# INLINE findProximateKnights #-}
findProximateKnights logicalColour coordinates MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour } = State.CoordinatesByRankByLogicalColour.findProximateKnights logicalColour coordinates coordinatesByRankByLogicalColour
sumPieceSquareValueByLogicalColour :: (
Enum x,
Enum y,
Num pieceSquareValue,
Ord x,
Ord y
)
=> Component.PieceSquareArray.PieceSquareArray x y pieceSquareValue
-> Board x y
-> Attribute.LogicalColour.ByLogicalColour pieceSquareValue
{-# SPECIALISE sumPieceSquareValueByLogicalColour :: Component.PieceSquareArray.PieceSquareArray T.X T.Y T.PieceSquareValue -> Board T.X T.Y -> Attribute.LogicalColour.ByLogicalColour T.PieceSquareValue #-}
sumPieceSquareValueByLogicalColour pieceSquareArray MkBoard {
getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour,
getNPieces = nPieces
} = Attribute.LogicalColour.listArrayByLogicalColour $ State.CoordinatesByRankByLogicalColour.sumPieceSquareValueByLogicalColour (
\logicalColour rank coordinates -> Component.PieceSquareArray.findPieceSquareValue nPieces logicalColour rank coordinates pieceSquareArray
) coordinatesByRankByLogicalColour
findAttackersOf :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates x y
-> Board x y
-> [(Cartesian.Coordinates.Coordinates x y, Attribute.Rank.Rank)]
{-# SPECIALISE findAttackersOf :: Attribute.LogicalColour.LogicalColour -> Cartesian.Coordinates.Coordinates T.X T.Y -> Board T.X T.Y -> [(Cartesian.Coordinates.Coordinates T.X T.Y, Attribute.Rank.Rank)] #-}
findAttackersOf destinationLogicalColour destination board@MkBoard { getMaybePieceByCoordinates = maybePieceByCoordinates } = [
(coordinates, Attribute.Rank.Knight) |
coordinates <- findProximateKnights (Property.Opposable.getOpposite destinationLogicalColour) destination board
] ++ Data.Maybe.mapMaybe (
\directionFromDestination -> State.MaybePieceByCoordinates.findAttackerInDirection destinationLogicalColour directionFromDestination destination maybePieceByCoordinates
) Attribute.Direction.range
findAttacksBy :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Component.Piece.Piece
-> Cartesian.Coordinates.Coordinates x y
-> Board x y
-> [Cartesian.Coordinates.Coordinates x y]
{-# SPECIALISE findAttacksBy :: Component.Piece.Piece -> Cartesian.Coordinates.Coordinates T.X T.Y -> Board T.X T.Y -> [Cartesian.Coordinates.Coordinates T.X T.Y] #-}
findAttacksBy piece destination board
| rank == Attribute.Rank.Knight = findProximateKnights logicalColour destination board
| otherwise = filter (
\source -> source /= destination && Component.Piece.canAttackAlong source destination piece && State.MaybePieceByCoordinates.isClear source destination (getMaybePieceByCoordinates board)
) . State.CoordinatesByRankByLogicalColour.dereference logicalColour rank $ getCoordinatesByRankByLogicalColour board
where
(logicalColour, rank) = Component.Piece.getLogicalColour &&& Component.Piece.getRank $ piece
isKingChecked :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Board x y
-> Bool
{-# SPECIALISE isKingChecked :: Attribute.LogicalColour.LogicalColour -> Board T.X T.Y -> Bool #-}
isKingChecked logicalColour board@MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour } = not . null $ findAttackersOf logicalColour (State.CoordinatesByRankByLogicalColour.getKingsCoordinates logicalColour coordinatesByRankByLogicalColour) board
exposesKing :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Component.Move.Move x y
-> Board x y
-> Bool
{-# SPECIALISE exposesKing :: Attribute.LogicalColour.LogicalColour -> Component.Move.Move T.X T.Y -> Board T.X T.Y -> Bool #-}
exposesKing logicalColour move board@MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour }
| source == kingsCoordinates = not . null $ findAttackersOf logicalColour (Component.Move.getDestination move) board
| Just directionFromKing <- Cartesian.Vector.toMaybeDirection (
Cartesian.Vector.measureDistance kingsCoordinates source :: Cartesian.Vector.VectorInt
)
, let maybePieceByCoordinates = getMaybePieceByCoordinates board
, State.MaybePieceByCoordinates.isClear kingsCoordinates source maybePieceByCoordinates
, Data.Maybe.maybe True (
not . Attribute.Direction.areAligned directionFromKing
) $ Cartesian.Vector.toMaybeDirection (
Component.Move.measureDistance move :: Cartesian.Vector.VectorInt
)
, Just (_, attackersRank) <- State.MaybePieceByCoordinates.findAttackerInDirection logicalColour directionFromKing source maybePieceByCoordinates
= attackersRank `notElem` Attribute.Rank.plodders
| otherwise = False
where
source = Component.Move.getSource move
kingsCoordinates = State.CoordinatesByRankByLogicalColour.getKingsCoordinates logicalColour coordinatesByRankByLogicalColour
countDefendersByCoordinatesByLogicalColour :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Board x y -> NDefendersByCoordinatesByLogicalColour x y
{-# SPECIALISE countDefendersByCoordinatesByLogicalColour :: Board T.X T.Y -> NDefendersByCoordinatesByLogicalColour T.X T.Y #-}
countDefendersByCoordinatesByLogicalColour board@MkBoard { getCoordinatesByRankByLogicalColour = coordinatesByRankByLogicalColour } = Attribute.LogicalColour.listArrayByLogicalColour [
Data.Map.fromList [
(
coordinates,
length $ findAttackersOf (
Property.Opposable.getOpposite logicalColour
) coordinates board
) |
rank <- Attribute.Rank.expendable,
coordinates <- State.CoordinatesByRankByLogicalColour.dereference logicalColour rank coordinatesByRankByLogicalColour
] | logicalColour <- Attribute.LogicalColour.range
]
summariseNDefendersByLogicalColour :: Board x y -> Attribute.LogicalColour.ByLogicalColour Component.Piece.NPieces
summariseNDefendersByLogicalColour MkBoard { getNDefendersByCoordinatesByLogicalColour = nDefendersByCoordinatesByLogicalColour } = Data.Array.IArray.amap (
Data.Map.foldl' (+) 0
) nDefendersByCoordinatesByLogicalColour