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