{-# LANGUAGE CPP, FlexibleContexts #-}
module BishBosh.State.Board(
Board(
getMaybePieceByCoordinates,
getCoordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour,
getNPiecesDifferenceByRank,
getNPawnsByFileByLogicalColour,
getNPieces,
getPassedPawnCoordinatesByLogicalColour
),
countDefendersByCoordinatesByLogicalColour,
summariseNDefendersByLogicalColour,
sumPieceSquareValueByLogicalColour,
findAttackersOf,
findAttacksBy,
movePiece,
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.Accountant as Component.Accountant
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.Piece as Component.Piece
import qualified BishBosh.Component.PieceSquareByCoordinatesByRank as Component.PieceSquareByCoordinatesByRank
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.ExtendedPositionDescription as Property.ExtendedPositionDescription
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
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.CoordinatesByRankByLogicalColour as State.CoordinatesByRankByLogicalColour
import qualified BishBosh.State.MaybePieceByCoordinates as State.MaybePieceByCoordinates
import qualified BishBosh.StateProperty.Censor as StateProperty.Censor
import qualified BishBosh.StateProperty.Hashable as StateProperty.Hashable
import qualified BishBosh.StateProperty.Mutator as StateProperty.Mutator
import qualified BishBosh.StateProperty.Seeker as StateProperty.Seeker
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Mass as Type.Mass
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Map.Strict as Map
import qualified Data.Maybe
import qualified ToolShed.Data.List
#ifdef USE_UNBOXED_ARRAYS
import qualified Data.Array.Unboxed
#endif
type Transformation = Board -> Board
type NDefendersByCoordinatesByLogicalColour = Attribute.LogicalColour.ArrayByLogicalColour (Map.Map Cartesian.Coordinates.Coordinates Type.Count.NPieces)
data Board = MkBoard {
Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates :: State.MaybePieceByCoordinates.MaybePieceByCoordinates,
Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour :: State.CoordinatesByRankByLogicalColour.CoordinatesByRankByLogicalColour,
Board -> NDefendersByCoordinatesByLogicalColour
getNDefendersByCoordinatesByLogicalColour :: NDefendersByCoordinatesByLogicalColour,
Board -> NPiecesByRank
getNPiecesDifferenceByRank :: StateProperty.Censor.NPiecesByRank,
Board -> NPiecesByFileByLogicalColour
getNPawnsByFileByLogicalColour :: StateProperty.Seeker.NPiecesByFileByLogicalColour,
Board -> NPieces
getNPieces :: Type.Count.NPieces,
Board -> CoordinatesByLogicalColour
getPassedPawnCoordinatesByLogicalColour :: State.CoordinatesByRankByLogicalColour.CoordinatesByLogicalColour
}
instance Eq Board where
MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates } == :: Board -> Board -> Bool
== MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates' } = MaybePieceByCoordinates
maybePieceByCoordinates MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
forall a. Eq a => a -> a -> Bool
== MaybePieceByCoordinates
maybePieceByCoordinates'
instance Control.DeepSeq.NFData Board where
rnf :: Board -> ()
rnf MkBoard {
getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour :: Board -> NDefendersByCoordinatesByLogicalColour
getNDefendersByCoordinatesByLogicalColour = NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour,
getNPiecesDifferenceByRank :: Board -> NPiecesByRank
getNPiecesDifferenceByRank = NPiecesByRank
nPiecesDifferenceByRank,
getNPawnsByFileByLogicalColour :: Board -> NPiecesByFileByLogicalColour
getNPawnsByFileByLogicalColour = NPiecesByFileByLogicalColour
nPawnsByFileByLogicalColour,
getNPieces :: Board -> NPieces
getNPieces = NPieces
nPieces,
getPassedPawnCoordinatesByLogicalColour :: Board -> CoordinatesByLogicalColour
getPassedPawnCoordinatesByLogicalColour = CoordinatesByLogicalColour
passedPawnCoordinatesByLogicalColour
} = (MaybePieceByCoordinates, CoordinatesByRankByLogicalColour,
NDefendersByCoordinatesByLogicalColour, NPiecesByRank,
NPiecesByFileByLogicalColour, NPieces, CoordinatesByLogicalColour)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
MaybePieceByCoordinates
maybePieceByCoordinates,
CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour,
NPiecesByRank
nPiecesDifferenceByRank,
NPiecesByFileByLogicalColour
nPawnsByFileByLogicalColour,
NPieces
nPieces,
CoordinatesByLogicalColour
passedPawnCoordinatesByLogicalColour
)
instance Read Board where
readsPrec :: NPieces -> ReadS Board
readsPrec NPieces
_ = ReadS Board
forall a. ReadsFEN a => ReadS a
Property.ForsythEdwards.readsFEN
instance Show Board where
showsPrec :: NPieces -> Board -> ShowS
showsPrec NPieces
_ = Board -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN
instance Property.ExtendedPositionDescription.ReadsEPD Board where
readsEPD :: ReadS Board
readsEPD = ((MaybePieceByCoordinates, String) -> (Board, String))
-> [(MaybePieceByCoordinates, String)] -> [(Board, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((MaybePieceByCoordinates -> Board)
-> (MaybePieceByCoordinates, String) -> (Board, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates) ([(MaybePieceByCoordinates, String)] -> [(Board, String)])
-> (String -> [(MaybePieceByCoordinates, String)]) -> ReadS Board
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(MaybePieceByCoordinates, String)]
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD
instance Property.ExtendedPositionDescription.ShowsEPD Board where
showsEPD :: Board -> ShowS
showsEPD MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates } = MaybePieceByCoordinates -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD MaybePieceByCoordinates
maybePieceByCoordinates
instance Property.ForsythEdwards.ReadsFEN Board where
readsFEN :: ReadS Board
readsFEN = ReadS Board
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD
instance Property.ForsythEdwards.ShowsFEN Board
instance Data.Default.Default Board where
def :: Board
def = MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates MaybePieceByCoordinates
forall a. Default a => a
Data.Default.def
instance Property.Empty.Empty Board where
empty :: Board
empty = MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates MaybePieceByCoordinates
forall a. Empty a => a
Property.Empty.empty
instance Property.Reflectable.ReflectableOnX Board where
reflectOnX :: Board -> Board
reflectOnX MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates } = MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates (MaybePieceByCoordinates -> Board)
-> MaybePieceByCoordinates -> Board
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates -> MaybePieceByCoordinates
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX MaybePieceByCoordinates
maybePieceByCoordinates
instance Property.Reflectable.ReflectableOnY Board where
reflectOnY :: Board -> Board
reflectOnY MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates } = MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates (MaybePieceByCoordinates -> Board)
-> MaybePieceByCoordinates -> Board
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates -> MaybePieceByCoordinates
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY MaybePieceByCoordinates
maybePieceByCoordinates
instance StateProperty.Hashable.Hashable Board where
listRandoms :: Board -> Zobrist positionHash -> [positionHash]
listRandoms MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = CoordinatesByRankByLogicalColour
-> Zobrist positionHash -> [positionHash]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
StateProperty.Hashable.listRandoms CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
instance StateProperty.Mutator.Mutator Board where
defineCoordinates :: Maybe Piece -> Coordinates -> Board -> Board
defineCoordinates Maybe Piece
maybePiece Coordinates
coordinates MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates } = MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates (MaybePieceByCoordinates -> Board)
-> MaybePieceByCoordinates -> Board
forall a b. (a -> b) -> a -> b
$ Maybe Piece
-> Coordinates
-> MaybePieceByCoordinates
-> MaybePieceByCoordinates
forall mutator.
Mutator mutator =>
Maybe Piece -> Coordinates -> mutator -> mutator
StateProperty.Mutator.defineCoordinates Maybe Piece
maybePiece Coordinates
coordinates MaybePieceByCoordinates
maybePieceByCoordinates
instance StateProperty.Seeker.Seeker Board where
findProximateKnights :: LogicalColour -> Coordinates -> Board -> [Coordinates]
findProximateKnights LogicalColour
logicalColour Coordinates
coordinates MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = LogicalColour
-> Coordinates -> CoordinatesByRankByLogicalColour -> [Coordinates]
forall seeker.
Seeker seeker =>
LogicalColour -> Coordinates -> seeker -> [Coordinates]
StateProperty.Seeker.findProximateKnights LogicalColour
logicalColour Coordinates
coordinates CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
findPieces :: (Piece -> Bool) -> Board -> [LocatedPiece]
findPieces Piece -> Bool
predicate MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = (Piece -> Bool)
-> CoordinatesByRankByLogicalColour -> [LocatedPiece]
forall seeker.
Seeker seeker =>
(Piece -> Bool) -> seeker -> [LocatedPiece]
StateProperty.Seeker.findPieces Piece -> Bool
predicate CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
countPawnsByFileByLogicalColour :: Board -> NPiecesByFileByLogicalColour
countPawnsByFileByLogicalColour MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = CoordinatesByRankByLogicalColour -> NPiecesByFileByLogicalColour
forall seeker.
Seeker seeker =>
seeker -> NPiecesByFileByLogicalColour
StateProperty.Seeker.countPawnsByFileByLogicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
fromMaybePieceByCoordinates :: State.MaybePieceByCoordinates.MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates :: MaybePieceByCoordinates -> Board
fromMaybePieceByCoordinates MaybePieceByCoordinates
maybePieceByCoordinates = Board
board where
board :: Board
board@MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = MkBoard :: MaybePieceByCoordinates
-> CoordinatesByRankByLogicalColour
-> NDefendersByCoordinatesByLogicalColour
-> NPiecesByRank
-> NPiecesByFileByLogicalColour
-> NPieces
-> CoordinatesByLogicalColour
-> Board
MkBoard {
getMaybePieceByCoordinates :: MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour :: CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = MaybePieceByCoordinates -> CoordinatesByRankByLogicalColour
State.CoordinatesByRankByLogicalColour.fromMaybePieceByCoordinates MaybePieceByCoordinates
maybePieceByCoordinates,
getNDefendersByCoordinatesByLogicalColour :: NDefendersByCoordinatesByLogicalColour
getNDefendersByCoordinatesByLogicalColour = Board -> NDefendersByCoordinatesByLogicalColour
countDefendersByCoordinatesByLogicalColour Board
board,
getNPiecesDifferenceByRank :: NPiecesByRank
getNPiecesDifferenceByRank = CoordinatesByRankByLogicalColour -> NPiecesByRank
forall censor. Censor censor => censor -> NPiecesByRank
StateProperty.Censor.countPieceDifferenceByRank CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getNPawnsByFileByLogicalColour :: NPiecesByFileByLogicalColour
getNPawnsByFileByLogicalColour = CoordinatesByRankByLogicalColour -> NPiecesByFileByLogicalColour
forall seeker.
Seeker seeker =>
seeker -> NPiecesByFileByLogicalColour
StateProperty.Seeker.countPawnsByFileByLogicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getNPieces :: NPieces
getNPieces = CoordinatesByRankByLogicalColour -> NPieces
forall censor. Censor censor => censor -> NPieces
StateProperty.Censor.countPieces CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getPassedPawnCoordinatesByLogicalColour :: CoordinatesByLogicalColour
getPassedPawnCoordinatesByLogicalColour = CoordinatesByRankByLogicalColour -> CoordinatesByLogicalColour
State.CoordinatesByRankByLogicalColour.findPassedPawnCoordinatesByLogicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
}
movePiece
:: Component.Move.Move
-> Maybe Attribute.MoveType.MoveType
-> Transformation
movePiece :: Move -> Maybe MoveType -> Board -> Board
movePiece Move
move Maybe MoveType
maybeMoveType board :: Board
board@MkBoard {
getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour :: Board -> NDefendersByCoordinatesByLogicalColour
getNDefendersByCoordinatesByLogicalColour = NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour,
getNPiecesDifferenceByRank :: Board -> NPiecesByRank
getNPiecesDifferenceByRank = NPiecesByRank
nPiecesDifferenceByRank,
getNPieces :: Board -> NPieces
getNPieces = NPieces
nPieces
}
| Just Piece
sourcePiece <- Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
source MaybePieceByCoordinates
maybePieceByCoordinates = let
oppositePiece :: Piece
oppositePiece = Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Piece
sourcePiece
(LogicalColour
logicalColour, LogicalColour
opponentsLogicalColour) = ((Piece -> LogicalColour) -> Piece -> LogicalColour
forall a b. (a -> b) -> a -> b
$ Piece
sourcePiece) ((Piece -> LogicalColour) -> LogicalColour)
-> ((Piece -> LogicalColour) -> LogicalColour)
-> (Piece -> LogicalColour)
-> (LogicalColour, LogicalColour)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Piece -> LogicalColour) -> Piece -> LogicalColour
forall a b. (a -> b) -> a -> b
$ Piece
oppositePiece) ((Piece -> LogicalColour) -> (LogicalColour, LogicalColour))
-> (Piece -> LogicalColour) -> (LogicalColour, LogicalColour)
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
Component.Piece.getLogicalColour
moveType :: Attribute.MoveType.MoveType
moveType :: MoveType
moveType
| Just MoveType
explicitMoveType <- Maybe MoveType
maybeMoveType = MoveType
explicitMoveType
| Move -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isEnPassantMove Move
move MaybePieceByCoordinates
maybePieceByCoordinates = MoveType
Attribute.MoveType.enPassant
| Bool
otherwise = Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType (
Piece -> Rank
Component.Piece.getRank (Piece -> Rank) -> Maybe Piece -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
destination MaybePieceByCoordinates
maybePieceByCoordinates
) (Maybe Rank -> MoveType) -> Maybe Rank -> MoveType
forall a b. (a -> b) -> a -> b
$ if Coordinates -> Piece -> Bool
Component.Piece.isPawnPromotion Coordinates
destination Piece
sourcePiece
then Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.defaultPromotionRank
else Maybe Rank
forall a. Maybe a
Nothing
(Maybe Rank
maybePromotionRank, Maybe Rank
maybeExplicitlyTakenRank) = MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank (MoveType -> Maybe Rank)
-> (MoveType -> Maybe Rank) -> MoveType -> (Maybe Rank, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& MoveType -> Maybe Rank
Attribute.MoveType.getMaybeExplicitlyTakenRank (MoveType -> (Maybe Rank, Maybe Rank))
-> MoveType -> (Maybe Rank, Maybe Rank)
forall a b. (a -> b) -> a -> b
$ MoveType
moveType
destinationPiece :: Piece
destinationPiece = (Piece -> Piece)
-> (Rank -> Piece -> Piece) -> Maybe Rank -> Piece -> Piece
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Piece -> Piece
forall a. a -> a
id Rank -> Piece -> Piece
Component.Piece.promote Maybe Rank
maybePromotionRank Piece
sourcePiece
wasPawnTakenExplicitly :: Bool
wasPawnTakenExplicitly = Maybe Rank
maybeExplicitlyTakenRank Maybe Rank -> Maybe Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.Pawn
eitherPassingPawnsDestinationOrMaybeTakenRank :: Either Coordinates (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank
| MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType = Coordinates -> Either Coordinates (Maybe Rank)
forall a b. a -> Either a b
Left (Coordinates -> Either Coordinates (Maybe Rank))
-> Coordinates -> Either Coordinates (Maybe Rank)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates
destination
| Bool
otherwise = Maybe Rank -> Either Coordinates (Maybe Rank)
forall a b. b -> Either a b
Right Maybe Rank
maybeExplicitlyTakenRank
eitherPassingPawnsDestinationOrMaybeTakenPiece :: Either Coordinates (Maybe Piece)
eitherPassingPawnsDestinationOrMaybeTakenPiece = (Rank -> Piece) -> Maybe Rank -> Maybe Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
opponentsLogicalColour) (Maybe Rank -> Maybe Piece)
-> Either Coordinates (Maybe Rank)
-> Either Coordinates (Maybe Piece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Coordinates (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank
board' :: Board
board'@MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates' } = MkBoard :: MaybePieceByCoordinates
-> CoordinatesByRankByLogicalColour
-> NDefendersByCoordinatesByLogicalColour
-> NPiecesByRank
-> NPiecesByFileByLogicalColour
-> NPieces
-> CoordinatesByLogicalColour
-> Board
MkBoard {
getMaybePieceByCoordinates :: MaybePieceByCoordinates
getMaybePieceByCoordinates = Move
-> Piece
-> Maybe Coordinates
-> MaybePieceByCoordinates
-> MaybePieceByCoordinates
State.MaybePieceByCoordinates.movePiece Move
move Piece
destinationPiece (
Coordinates -> Maybe Coordinates
forall a. a -> Maybe a
Just (Coordinates -> Maybe Coordinates)
-> (Maybe Rank -> Maybe Coordinates)
-> Either Coordinates (Maybe Rank)
-> Maybe Coordinates
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Maybe Coordinates -> Maybe Rank -> Maybe Coordinates
forall a b. a -> b -> a
const Maybe Coordinates
forall a. Maybe a
Nothing (Either Coordinates (Maybe Rank) -> Maybe Coordinates)
-> Either Coordinates (Maybe Rank) -> Maybe Coordinates
forall a b. (a -> b) -> a -> b
$ Either Coordinates (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank
) MaybePieceByCoordinates
maybePieceByCoordinates,
getCoordinatesByRankByLogicalColour :: CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = Move
-> Piece
-> Maybe Rank
-> Either Coordinates (Maybe Rank)
-> Transformation
State.CoordinatesByRankByLogicalColour.movePiece Move
move Piece
sourcePiece Maybe Rank
maybePromotionRank Either Coordinates (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getNDefendersByCoordinatesByLogicalColour :: NDefendersByCoordinatesByLogicalColour
getNDefendersByCoordinatesByLogicalColour = (
\(Map Coordinates NPieces
nBlackDefendersByCoordinates, Map Coordinates NPieces
nWhiteDefendersByCoordinates) -> [Map Coordinates NPieces] -> NDefendersByCoordinatesByLogicalColour
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour [Map Coordinates NPieces
nBlackDefendersByCoordinates, Map Coordinates NPieces
nWhiteDefendersByCoordinates]
) ((Map Coordinates NPieces, Map Coordinates NPieces)
-> NDefendersByCoordinatesByLogicalColour)
-> ([LocatedPiece]
-> (Map Coordinates NPieces, Map Coordinates NPieces))
-> [LocatedPiece]
-> NDefendersByCoordinatesByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocatedPiece
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces))
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> [LocatedPiece]
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\(Coordinates
affectedCoordinates, Piece
affectedPiece) -> if Piece -> Bool
Component.Piece.isKing Piece
affectedPiece
then (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall a. a -> a
id
else let
logicalColour' :: LogicalColour
logicalColour' = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
affectedPiece
in (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour'
then (Map Coordinates NPieces -> Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first
else (Map Coordinates NPieces -> Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second
) ((Map Coordinates NPieces -> Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces))
-> ([(Coordinates, Rank)]
-> Map Coordinates NPieces -> Map Coordinates NPieces)
-> [(Coordinates, Rank)]
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates
-> NPieces -> Map Coordinates NPieces -> Map Coordinates NPieces
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Coordinates
affectedCoordinates (NPieces -> Map Coordinates NPieces -> Map Coordinates NPieces)
-> ([(Coordinates, Rank)] -> NPieces)
-> [(Coordinates, Rank)]
-> Map Coordinates NPieces
-> Map Coordinates NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces)
-> ([(Coordinates, Rank)] -> NPieces)
-> [(Coordinates, Rank)]
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, Rank)] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length ([(Coordinates, Rank)]
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces))
-> [(Coordinates, Rank)]
-> (Map Coordinates NPieces, Map Coordinates NPieces)
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
findAttackersOf (
LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour'
) Coordinates
affectedCoordinates Board
board'
) (
(NDefendersByCoordinatesByLogicalColour
-> LogicalColour -> Map Coordinates NPieces
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
Attribute.LogicalColour.Black) (NDefendersByCoordinatesByLogicalColour -> Map Coordinates NPieces)
-> (NDefendersByCoordinatesByLogicalColour
-> Map Coordinates NPieces)
-> NDefendersByCoordinatesByLogicalColour
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (NDefendersByCoordinatesByLogicalColour
-> LogicalColour -> Map Coordinates NPieces
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
Attribute.LogicalColour.White) (NDefendersByCoordinatesByLogicalColour
-> (Map Coordinates NPieces, Map Coordinates NPieces))
-> NDefendersByCoordinatesByLogicalColour
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall a b. (a -> b) -> a -> b
$ NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour NDefendersByCoordinatesByLogicalColour
-> [(LogicalColour, Map Coordinates NPieces)]
-> NDefendersByCoordinatesByLogicalColour
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// (
let
nDefendersByCoordinates :: Map Coordinates NPieces
nDefendersByCoordinates = NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour NDefendersByCoordinatesByLogicalColour
-> LogicalColour -> Map Coordinates NPieces
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
opponentsLogicalColour
in (
\Coordinates
passingPawnsDestination -> (:) (
LogicalColour
opponentsLogicalColour,
Coordinates -> Map Coordinates NPieces -> Map Coordinates NPieces
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coordinates
passingPawnsDestination Map Coordinates NPieces
nDefendersByCoordinates
)
) (Coordinates
-> [(LogicalColour, Map Coordinates NPieces)]
-> [(LogicalColour, Map Coordinates NPieces)])
-> (Maybe Rank
-> [(LogicalColour, Map Coordinates NPieces)]
-> [(LogicalColour, Map Coordinates NPieces)])
-> Either Coordinates (Maybe Rank)
-> [(LogicalColour, Map Coordinates NPieces)]
-> [(LogicalColour, Map Coordinates NPieces)]
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (
\Maybe Rank
maybeExplicitlyTakenRank' -> if Maybe Rank -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe Rank
maybeExplicitlyTakenRank'
then (:) (
LogicalColour
opponentsLogicalColour,
Coordinates -> Map Coordinates NPieces -> Map Coordinates NPieces
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coordinates
destination Map Coordinates NPieces
nDefendersByCoordinates
)
else [(LogicalColour, Map Coordinates NPieces)]
-> [(LogicalColour, Map Coordinates NPieces)]
forall a. a -> a
id
) (Either Coordinates (Maybe Rank)
-> [(LogicalColour, Map Coordinates NPieces)]
-> [(LogicalColour, Map Coordinates NPieces)])
-> Either Coordinates (Maybe Rank)
-> [(LogicalColour, Map Coordinates NPieces)]
-> [(LogicalColour, Map Coordinates NPieces)]
forall a b. (a -> b) -> a -> b
$ Either Coordinates (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank
) [
(
LogicalColour
logicalColour,
Coordinates -> Map Coordinates NPieces -> Map Coordinates NPieces
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coordinates
source (Map Coordinates NPieces -> Map Coordinates NPieces)
-> Map Coordinates NPieces -> Map Coordinates NPieces
forall a b. (a -> b) -> a -> b
$ NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour NDefendersByCoordinatesByLogicalColour
-> LogicalColour -> Map Coordinates NPieces
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
)
]
) ([LocatedPiece]
-> (Map Coordinates NPieces, Map Coordinates NPieces))
-> ([LocatedPiece] -> [LocatedPiece])
-> [LocatedPiece]
-> (Map Coordinates NPieces, Map Coordinates NPieces)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocatedPiece -> LocatedPiece -> Bool)
-> [LocatedPiece] -> [LocatedPiece]
forall a. (a -> a -> Bool) -> [a] -> [a]
Data.List.nubBy (
(LocatedPiece -> Coordinates)
-> LocatedPiece -> LocatedPiece -> Bool
forall b a. Eq b => (a -> b) -> Matches a
ToolShed.Data.List.equalityBy LocatedPiece -> Coordinates
forall a b. (a, b) -> a
fst
) ([LocatedPiece] -> NDefendersByCoordinatesByLogicalColour)
-> [LocatedPiece] -> NDefendersByCoordinatesByLogicalColour
forall a b. (a -> b) -> a -> b
$ [
(Coordinates
affectedCoordinates, Piece
affectedPiece) |
(Coordinates
knightsCoordinates, Piece
knight) <- (Coordinates
source, Piece
sourcePiece) LocatedPiece -> [LocatedPiece] -> [LocatedPiece]
forall a. a -> [a] -> [a]
: (,) Coordinates
destination (Piece -> LocatedPiece) -> [Piece] -> [LocatedPiece]
forall a b. (a -> b) -> [a] -> [b]
`map` (Piece
destinationPiece Piece -> [Piece] -> [Piece]
forall a. a -> [a] -> [a]
: ([Piece] -> Coordinates -> [Piece]
forall a b. a -> b -> a
const [] (Coordinates -> [Piece])
-> (Maybe Piece -> [Piece])
-> Either Coordinates (Maybe Piece)
-> [Piece]
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Maybe Piece -> [Piece]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList) Either Coordinates (Maybe Piece)
eitherPassingPawnsDestinationOrMaybeTakenPiece),
Piece -> Bool
Component.Piece.isKnight Piece
knight,
Just Coordinates
affectedCoordinates <- Coordinates -> Vector -> Maybe Coordinates
Cartesian.Vector.maybeTranslate Coordinates
knightsCoordinates (Vector -> Maybe Coordinates) -> [Vector] -> [Maybe Coordinates]
forall a b. (a -> b) -> [a] -> [b]
`map` [Vector]
Cartesian.Vector.attackVectorsForKnight,
Piece
affectedPiece <- Maybe Piece -> [Piece]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe Piece -> [Piece]) -> Maybe Piece -> [Piece]
forall a b. (a -> b) -> a -> b
$ Coordinates -> MaybePieceByCoordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates
affectedCoordinates MaybePieceByCoordinates
maybePieceByCoordinates',
Piece -> Piece -> Bool
Component.Piece.isFriend Piece
knight Piece
affectedPiece
] [LocatedPiece] -> [LocatedPiece] -> [LocatedPiece]
forall a. [a] -> [a] -> [a]
++ [
(Coordinates
blockingCoordinates, Piece
blockingPiece) |
Coordinates
passingPawnsDestination <- Coordinates -> [Coordinates]
forall (m :: * -> *) a. Monad m => a -> m a
return (Coordinates -> [Coordinates])
-> (Maybe Rank -> [Coordinates])
-> Either Coordinates (Maybe Rank)
-> [Coordinates]
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| [Coordinates] -> Maybe Rank -> [Coordinates]
forall a b. a -> b -> a
const [] (Either Coordinates (Maybe Rank) -> [Coordinates])
-> Either Coordinates (Maybe Rank) -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ Either Coordinates (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank,
(Direction
direction, Direction
antiParallelDirection) <- [(Direction, Direction)]
Attribute.Direction.opposites,
(Coordinates
blockingCoordinates, Piece
blockingPiece) <- case ((Direction -> Maybe LocatedPiece)
-> Direction -> Maybe LocatedPiece
forall a b. (a -> b) -> a -> b
$ Direction
direction) ((Direction -> Maybe LocatedPiece) -> Maybe LocatedPiece)
-> ((Direction -> Maybe LocatedPiece) -> Maybe LocatedPiece)
-> (Direction -> Maybe LocatedPiece)
-> (Maybe LocatedPiece, Maybe LocatedPiece)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Direction -> Maybe LocatedPiece)
-> Direction -> Maybe LocatedPiece
forall a b. (a -> b) -> a -> b
$ Direction
antiParallelDirection) ((Direction -> Maybe LocatedPiece)
-> (Maybe LocatedPiece, Maybe LocatedPiece))
-> (Direction -> Maybe LocatedPiece)
-> (Maybe LocatedPiece, Maybe LocatedPiece)
forall a b. (a -> b) -> a -> b
$ ((MaybePieceByCoordinates -> Maybe LocatedPiece)
-> MaybePieceByCoordinates -> Maybe LocatedPiece
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates
maybePieceByCoordinates') ((MaybePieceByCoordinates -> Maybe LocatedPiece)
-> Maybe LocatedPiece)
-> (Direction -> MaybePieceByCoordinates -> Maybe LocatedPiece)
-> Direction
-> Maybe LocatedPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Direction
-> Coordinates -> MaybePieceByCoordinates -> Maybe LocatedPiece
`State.MaybePieceByCoordinates.findBlockingPiece` Coordinates
passingPawnsDestination) of
(Just LocatedPiece
cp, Just LocatedPiece
cp') -> [
LocatedPiece
cp |
let isDefendedBy :: Coordinates -> Piece -> Bool
isDefendedBy Coordinates
from = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Piece -> (Bool, Bool)) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
from (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp),
Coordinates -> Piece -> Bool
isDefendedBy Coordinates
passingPawnsDestination Piece
oppositePiece Bool -> Bool -> Bool
|| (Coordinates -> Piece -> Bool) -> LocatedPiece -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Piece -> Bool
isDefendedBy LocatedPiece
cp'
] [LocatedPiece] -> [LocatedPiece] -> [LocatedPiece]
forall a. [a] -> [a] -> [a]
++ [
LocatedPiece
cp' |
let isDefendedBy :: Coordinates -> Piece -> Bool
isDefendedBy Coordinates
from = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Piece -> (Bool, Bool)) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
from (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp'),
Coordinates -> Piece -> Bool
isDefendedBy Coordinates
passingPawnsDestination Piece
oppositePiece Bool -> Bool -> Bool
|| (Coordinates -> Piece -> Bool) -> LocatedPiece -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Piece -> Bool
isDefendedBy LocatedPiece
cp
]
(Just LocatedPiece
cp, Maybe LocatedPiece
_) -> [
LocatedPiece
cp |
(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
passingPawnsDestination (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp) Piece
oppositePiece
]
(Maybe LocatedPiece
_, Just LocatedPiece
cp') -> [
LocatedPiece
cp' |
(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
passingPawnsDestination (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp') Piece
oppositePiece
]
(Maybe LocatedPiece, Maybe LocatedPiece)
_ -> []
] [LocatedPiece] -> [LocatedPiece] -> [LocatedPiece]
forall a. [a] -> [a] -> [a]
++ (Coordinates
destination, Piece
destinationPiece) LocatedPiece -> [LocatedPiece] -> [LocatedPiece]
forall a. a -> [a] -> [a]
: [
(Coordinates
blockingCoordinates, Piece
blockingPiece) |
let maybeExplicitlyTakenPiece :: Maybe Piece
maybeExplicitlyTakenPiece = Maybe Piece -> Coordinates -> Maybe Piece
forall a b. a -> b -> a
const Maybe Piece
forall a. Maybe a
Nothing (Coordinates -> Maybe Piece)
-> (Maybe Piece -> Maybe Piece)
-> Either Coordinates (Maybe Piece)
-> Maybe Piece
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| Maybe Piece -> Maybe Piece
forall a. a -> a
id (Either Coordinates (Maybe Piece) -> Maybe Piece)
-> Either Coordinates (Maybe Piece) -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ Either Coordinates (Maybe Piece)
eitherPassingPawnsDestinationOrMaybeTakenPiece,
(Direction
direction, Direction
antiParallelDirection) <- [(Direction, Direction)]
Attribute.Direction.opposites,
(Coordinates
coordinates, Piece
piece) <- [(Coordinates
source, Piece
sourcePiece), (Coordinates
destination, Piece
destinationPiece)],
(Coordinates
blockingCoordinates, Piece
blockingPiece) <- case ((Direction -> Maybe LocatedPiece)
-> Direction -> Maybe LocatedPiece
forall a b. (a -> b) -> a -> b
$ Direction
direction) ((Direction -> Maybe LocatedPiece) -> Maybe LocatedPiece)
-> ((Direction -> Maybe LocatedPiece) -> Maybe LocatedPiece)
-> (Direction -> Maybe LocatedPiece)
-> (Maybe LocatedPiece, Maybe LocatedPiece)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Direction -> Maybe LocatedPiece)
-> Direction -> Maybe LocatedPiece
forall a b. (a -> b) -> a -> b
$ Direction
antiParallelDirection) ((Direction -> Maybe LocatedPiece)
-> (Maybe LocatedPiece, Maybe LocatedPiece))
-> (Direction -> Maybe LocatedPiece)
-> (Maybe LocatedPiece, Maybe LocatedPiece)
forall a b. (a -> b) -> a -> b
$ ((MaybePieceByCoordinates -> Maybe LocatedPiece)
-> MaybePieceByCoordinates -> Maybe LocatedPiece
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates
maybePieceByCoordinates') ((MaybePieceByCoordinates -> Maybe LocatedPiece)
-> Maybe LocatedPiece)
-> (Direction -> MaybePieceByCoordinates -> Maybe LocatedPiece)
-> Direction
-> Maybe LocatedPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Direction
-> Coordinates -> MaybePieceByCoordinates -> Maybe LocatedPiece
`State.MaybePieceByCoordinates.findBlockingPiece` Coordinates
coordinates) of
(Just LocatedPiece
cp, Just LocatedPiece
cp') -> [
LocatedPiece
cp |
let isDefendedBy :: Coordinates -> Piece -> Bool
isDefendedBy Coordinates
from = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Piece -> (Bool, Bool)) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
from (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp),
Coordinates -> Piece -> Bool
isDefendedBy Coordinates
coordinates Piece
piece Bool -> Bool -> Bool
|| Coordinates
coordinates Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
destination Bool -> Bool -> Bool
&& Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (Coordinates -> Piece -> Bool
isDefendedBy Coordinates
destination) Maybe Piece
maybeExplicitlyTakenPiece Bool -> Bool -> Bool
|| (Coordinates -> Piece -> Bool) -> LocatedPiece -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Piece -> Bool
isDefendedBy LocatedPiece
cp'
] [LocatedPiece] -> [LocatedPiece] -> [LocatedPiece]
forall a. [a] -> [a] -> [a]
++ [
LocatedPiece
cp' |
let isDefendedBy :: Coordinates -> Piece -> Bool
isDefendedBy Coordinates
from = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Piece -> (Bool, Bool)) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
from (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp'),
Coordinates -> Piece -> Bool
isDefendedBy Coordinates
coordinates Piece
piece Bool -> Bool -> Bool
|| Coordinates
coordinates Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
destination Bool -> Bool -> Bool
&& Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (Coordinates -> Piece -> Bool
isDefendedBy Coordinates
destination) Maybe Piece
maybeExplicitlyTakenPiece Bool -> Bool -> Bool
|| (Coordinates -> Piece -> Bool) -> LocatedPiece -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Piece -> Bool
isDefendedBy LocatedPiece
cp
]
(Just LocatedPiece
cp, Maybe LocatedPiece
_) -> [
LocatedPiece
cp |
let isDefendedBy :: Piece -> Bool
isDefendedBy = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Piece -> (Bool, Bool)) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
coordinates (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp),
Piece -> Bool
isDefendedBy Piece
piece Bool -> Bool -> Bool
|| Coordinates
coordinates Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
destination Bool -> Bool -> Bool
&& Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False Piece -> Bool
isDefendedBy Maybe Piece
maybeExplicitlyTakenPiece
]
(Maybe LocatedPiece
_, Just LocatedPiece
cp') -> [
LocatedPiece
cp' |
let isDefendedBy :: Piece -> Bool
isDefendedBy = (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (Piece -> (Bool, Bool)) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool))
-> (Piece -> Bool, Piece -> Bool) -> Piece -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
coordinates (Coordinates -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> LocatedPiece
-> (Piece -> Bool, Piece -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Piece -> Piece -> Bool
Component.Piece.isFriend (LocatedPiece -> (Piece -> Bool, Piece -> Bool))
-> LocatedPiece -> (Piece -> Bool, Piece -> Bool)
forall a b. (a -> b) -> a -> b
$ LocatedPiece
cp'),
Piece -> Bool
isDefendedBy Piece
piece Bool -> Bool -> Bool
|| Coordinates
coordinates Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
destination Bool -> Bool -> Bool
&& Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False Piece -> Bool
isDefendedBy Maybe Piece
maybeExplicitlyTakenPiece
]
(Maybe LocatedPiece, Maybe LocatedPiece)
_ -> []
],
getNPiecesDifferenceByRank :: NPiecesByRank
getNPiecesDifferenceByRank = (NPieces -> NPieces -> NPieces)
-> NPiecesByRank -> [(Rank, NPieces)] -> NPiecesByRank
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> a i e -> [(i, e')] -> a i e
Data.Array.IArray.accum (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
then (-)
else NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
(+)
) NPiecesByRank
nPiecesDifferenceByRank ([(Rank, NPieces)] -> NPiecesByRank)
-> [(Rank, NPieces)] -> NPiecesByRank
forall a b. (a -> b) -> a -> b
$ if MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType
then [(Rank
Attribute.Rank.Pawn, NPieces
1)]
else ([(Rank, NPieces)] -> [(Rank, NPieces)])
-> (Rank -> [(Rank, NPieces)] -> [(Rank, NPieces)])
-> Maybe Rank
-> [(Rank, NPieces)]
-> [(Rank, NPieces)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [(Rank, NPieces)] -> [(Rank, NPieces)]
forall a. a -> a
id (
(:) ((Rank, NPieces) -> [(Rank, NPieces)] -> [(Rank, NPieces)])
-> (Rank -> (Rank, NPieces))
-> Rank
-> [(Rank, NPieces)]
-> [(Rank, NPieces)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank -> NPieces -> (Rank, NPieces))
-> NPieces -> Rank -> (Rank, NPieces)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) NPieces
1
) Maybe Rank
maybeExplicitlyTakenRank ([(Rank, NPieces)] -> [(Rank, NPieces)])
-> [(Rank, NPieces)] -> [(Rank, NPieces)]
forall a b. (a -> b) -> a -> b
$ [(Rank, NPieces)]
-> (Rank -> [(Rank, NPieces)]) -> Maybe Rank -> [(Rank, NPieces)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] (
\Rank
promotionRank -> [
(
Rank
promotionRank,
NPieces
1
), (
Rank
Attribute.Rank.Pawn,
NPieces -> NPieces
forall a. Num a => a -> a
negate NPieces
1
)
]
) Maybe Rank
maybePromotionRank,
getNPawnsByFileByLogicalColour :: NPiecesByFileByLogicalColour
getNPawnsByFileByLogicalColour = if Piece -> Bool
Component.Piece.isPawn Piece
sourcePiece Bool -> Bool -> Bool
&& Bool -> Bool
not (MoveType -> Bool
Attribute.MoveType.isQuiet MoveType
moveType) Bool -> Bool -> Bool
|| Bool
wasPawnTakenExplicitly
then CoordinatesByRankByLogicalColour -> NPiecesByFileByLogicalColour
forall seeker.
Seeker seeker =>
seeker -> NPiecesByFileByLogicalColour
StateProperty.Seeker.countPawnsByFileByLogicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour'
else Board -> NPiecesByFileByLogicalColour
getNPawnsByFileByLogicalColour Board
board,
getNPieces :: NPieces
getNPieces = MoveType -> NPieces -> NPieces
forall nPieces. Enum nPieces => MoveType -> nPieces -> nPieces
Attribute.MoveType.nPiecesMutator MoveType
moveType NPieces
nPieces,
getPassedPawnCoordinatesByLogicalColour :: CoordinatesByLogicalColour
getPassedPawnCoordinatesByLogicalColour = if Piece -> Bool
Component.Piece.isPawn Piece
sourcePiece Bool -> Bool -> Bool
|| Bool
wasPawnTakenExplicitly
then CoordinatesByRankByLogicalColour -> CoordinatesByLogicalColour
State.CoordinatesByRankByLogicalColour.findPassedPawnCoordinatesByLogicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour'
else Board -> CoordinatesByLogicalColour
getPassedPawnCoordinatesByLogicalColour Board
board
}
coordinatesByRankByLogicalColour' :: CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour' = Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour Board
board'
in Board
board'
| Bool
otherwise = Exception -> Board
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Board) -> (String -> Exception) -> String -> Board
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.Board.movePiece:\tno piece exists at " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> ShowS
forall a. Show a => a -> ShowS
shows Coordinates
source ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> Board) -> String -> Board
forall a b. (a -> b) -> a -> b
$ Board -> ShowS
forall a. Show a => a -> ShowS
shows Board
board String
"."
where
(Coordinates
source, Coordinates
destination) = Move -> Coordinates
Component.Move.getSource (Move -> Coordinates)
-> (Move -> Coordinates) -> Move -> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move -> Coordinates
Component.Move.getDestination (Move -> (Coordinates, Coordinates))
-> Move -> (Coordinates, Coordinates)
forall a b. (a -> b) -> a -> b
$ Move
move
sumPieceSquareValueByLogicalColour :: (
#ifdef USE_UNBOXED_ARRAYS
Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue,
#endif
Num pieceSquareValue
)
=> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue
-> Board
->
#ifdef USE_UNBOXED_ARRAYS
Attribute.LogicalColour.UArrayByLogicalColour
#else
Attribute.LogicalColour.ArrayByLogicalColour
#endif
pieceSquareValue
{-# SPECIALISE sumPieceSquareValueByLogicalColour
:: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank Type.Mass.PieceSquareValue
-> Board
->
#ifdef USE_UNBOXED_ARRAYS
Attribute.LogicalColour.UArrayByLogicalColour
#else
Attribute.LogicalColour.ArrayByLogicalColour
#endif
Type.Mass.PieceSquareValue
#-}
sumPieceSquareValueByLogicalColour :: PieceSquareByCoordinatesByRank pieceSquareValue
-> Board -> ArrayByLogicalColour pieceSquareValue
sumPieceSquareValueByLogicalColour PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank MkBoard {
getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
getNPieces :: Board -> NPieces
getNPieces = NPieces
nPieces
} = [pieceSquareValue] -> ArrayByLogicalColour pieceSquareValue
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([pieceSquareValue] -> ArrayByLogicalColour pieceSquareValue)
-> [pieceSquareValue] -> ArrayByLogicalColour pieceSquareValue
forall a b. (a -> b) -> a -> b
$ PieceSquareByCoordinatesByRank pieceSquareValue
-> NPieces
-> CoordinatesByRankByLogicalColour
-> [pieceSquareValue]
forall accountant pieceSquareValue.
(Accountant accountant, Num pieceSquareValue) =>
PieceSquareByCoordinatesByRank pieceSquareValue
-> NPieces -> accountant -> [pieceSquareValue]
Component.Accountant.sumPieceSquareValueByLogicalColour PieceSquareByCoordinatesByRank pieceSquareValue
pieceSquareByCoordinatesByRank NPieces
nPieces CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
findAttackersOf
:: Attribute.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates
-> Board
-> [(Cartesian.Coordinates.Coordinates, Attribute.Rank.Rank)]
findAttackersOf :: LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
findAttackersOf LogicalColour
destinationLogicalColour Coordinates
destination board :: Board
board@MkBoard { getMaybePieceByCoordinates :: Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates = MaybePieceByCoordinates
maybePieceByCoordinates } = [
(Coordinates
coordinates, Rank
Attribute.Rank.Knight) |
Coordinates
coordinates <- LogicalColour -> Coordinates -> Board -> [Coordinates]
forall seeker.
Seeker seeker =>
LogicalColour -> Coordinates -> seeker -> [Coordinates]
StateProperty.Seeker.findProximateKnights (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
destinationLogicalColour) Coordinates
destination Board
board
] [(Coordinates, Rank)]
-> [(Coordinates, Rank)] -> [(Coordinates, Rank)]
forall a. [a] -> [a] -> [a]
++ (Direction -> Maybe (Coordinates, Rank))
-> [Direction] -> [(Coordinates, Rank)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (
\Direction
directionFromDestination -> LogicalColour
-> Direction
-> Coordinates
-> MaybePieceByCoordinates
-> Maybe (Coordinates, Rank)
State.MaybePieceByCoordinates.findAttackerInDirection LogicalColour
destinationLogicalColour Direction
directionFromDestination Coordinates
destination MaybePieceByCoordinates
maybePieceByCoordinates
) [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
findAttacksBy
:: Component.Piece.Piece
-> Cartesian.Coordinates.Coordinates
-> Board
-> [Cartesian.Coordinates.Coordinates]
findAttacksBy :: Piece -> Coordinates -> Board -> [Coordinates]
findAttacksBy Piece
piece Coordinates
destination Board
board
| Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.Knight = LogicalColour -> Coordinates -> Board -> [Coordinates]
forall seeker.
Seeker seeker =>
LogicalColour -> Coordinates -> seeker -> [Coordinates]
StateProperty.Seeker.findProximateKnights LogicalColour
logicalColour Coordinates
destination Board
board
| Bool
otherwise = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates]
forall a. (a -> Bool) -> [a] -> [a]
filter (
\Coordinates
source -> Coordinates
source Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates
destination Bool -> Bool -> Bool
&& Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
source Coordinates
destination Piece
piece Bool -> Bool -> Bool
&& Coordinates -> Coordinates -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isClear Coordinates
source Coordinates
destination (Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates Board
board)
) ([Coordinates] -> [Coordinates])
-> (CoordinatesByRankByLogicalColour -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
rank (CoordinatesByRankByLogicalColour -> [Coordinates])
-> CoordinatesByRankByLogicalColour -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour Board
board
where
(LogicalColour
logicalColour, Rank
rank) = Piece -> LogicalColour
Component.Piece.getLogicalColour (Piece -> LogicalColour)
-> (Piece -> Rank) -> Piece -> (LogicalColour, Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Piece -> Rank
Component.Piece.getRank (Piece -> (LogicalColour, Rank)) -> Piece -> (LogicalColour, Rank)
forall a b. (a -> b) -> a -> b
$ Piece
piece
isKingChecked
:: Attribute.LogicalColour.LogicalColour
-> Board
-> Bool
isKingChecked :: LogicalColour -> Board -> Bool
isKingChecked LogicalColour
logicalColour board :: Board
board@MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = Bool -> Bool
not (Bool -> Bool)
-> ([(Coordinates, Rank)] -> Bool) -> [(Coordinates, Rank)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates, Rank)] -> Bool) -> [(Coordinates, Rank)] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
findAttackersOf LogicalColour
logicalColour (LogicalColour -> CoordinatesByRankByLogicalColour -> Coordinates
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour) Board
board
exposesKing
:: Attribute.LogicalColour.LogicalColour
-> Component.Move.Move
-> Board
-> Bool
exposesKing :: LogicalColour -> Move -> Board -> Bool
exposesKing LogicalColour
logicalColour Move
move board :: Board
board@MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour }
| Coordinates
source Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
kingsCoordinates = Bool -> Bool
not (Bool -> Bool)
-> ([(Coordinates, Rank)] -> Bool) -> [(Coordinates, Rank)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates, Rank)] -> Bool) -> [(Coordinates, Rank)] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
findAttackersOf LogicalColour
logicalColour (Move -> Coordinates
Component.Move.getDestination Move
move) Board
board
| Just Direction
directionFromKing <- Vector -> Maybe Direction
Cartesian.Vector.toMaybeDirection (Vector -> Maybe Direction) -> Vector -> Maybe Direction
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
kingsCoordinates Coordinates
source
, let maybePieceByCoordinates :: MaybePieceByCoordinates
maybePieceByCoordinates = Board -> MaybePieceByCoordinates
getMaybePieceByCoordinates Board
board
, Coordinates -> Coordinates -> MaybePieceByCoordinates -> Bool
State.MaybePieceByCoordinates.isClear Coordinates
kingsCoordinates Coordinates
source MaybePieceByCoordinates
maybePieceByCoordinates
, Bool -> (Direction -> Bool) -> Maybe Direction -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True (
Bool -> Bool
not (Bool -> Bool) -> (Direction -> Bool) -> Direction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Direction -> Bool
Attribute.Direction.areAligned Direction
directionFromKing
) (Maybe Direction -> Bool)
-> (Vector -> Maybe Direction) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector -> Maybe Direction
Cartesian.Vector.toMaybeDirection (Vector -> Bool) -> Vector -> Bool
forall a b. (a -> b) -> a -> b
$ Move -> Vector
Component.Move.measureDistance Move
move
, Just (Coordinates
_, Rank
attackersRank) <- LogicalColour
-> Direction
-> Coordinates
-> MaybePieceByCoordinates
-> Maybe (Coordinates, Rank)
State.MaybePieceByCoordinates.findAttackerInDirection LogicalColour
logicalColour Direction
directionFromKing Coordinates
source MaybePieceByCoordinates
maybePieceByCoordinates
= Rank
attackersRank Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rank]
Attribute.Rank.plodders
| Bool
otherwise = Bool
False
where
source :: Coordinates
source = Move -> Coordinates
Component.Move.getSource Move
move
kingsCoordinates :: Coordinates
kingsCoordinates = LogicalColour -> CoordinatesByRankByLogicalColour -> Coordinates
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
countDefendersByCoordinatesByLogicalColour :: Board -> NDefendersByCoordinatesByLogicalColour
countDefendersByCoordinatesByLogicalColour :: Board -> NDefendersByCoordinatesByLogicalColour
countDefendersByCoordinatesByLogicalColour board :: Board
board@MkBoard { getCoordinatesByRankByLogicalColour :: Board -> CoordinatesByRankByLogicalColour
getCoordinatesByRankByLogicalColour = CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour } = [Map Coordinates NPieces] -> NDefendersByCoordinatesByLogicalColour
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour [
[(Coordinates, NPieces)] -> Map Coordinates NPieces
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
(
Coordinates
coordinates,
NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces)
-> ([(Coordinates, Rank)] -> NPieces)
-> [(Coordinates, Rank)]
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, Rank)] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length ([(Coordinates, Rank)] -> NPieces)
-> [(Coordinates, Rank)] -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates -> Board -> [(Coordinates, Rank)]
findAttackersOf (
LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
) Coordinates
coordinates Board
board
) |
Rank
rank <- [Rank]
Attribute.Rank.expendable,
Coordinates
coordinates <- LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
rank CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
] | LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
]
summariseNDefendersByLogicalColour :: Board -> Attribute.LogicalColour.ArrayByLogicalColour Type.Count.NPieces
summariseNDefendersByLogicalColour :: Board -> ArrayByLogicalColour NPieces
summariseNDefendersByLogicalColour MkBoard { getNDefendersByCoordinatesByLogicalColour :: Board -> NDefendersByCoordinatesByLogicalColour
getNDefendersByCoordinatesByLogicalColour = NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour } = (Map Coordinates NPieces -> NPieces)
-> NDefendersByCoordinatesByLogicalColour
-> ArrayByLogicalColour NPieces
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
Data.Array.IArray.amap (
(NPieces -> NPieces -> NPieces)
-> NPieces -> Map Coordinates NPieces -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
(+) NPieces
0
) NDefendersByCoordinatesByLogicalColour
nDefendersByCoordinatesByLogicalColour