module BishBosh.State.CoordinatesByRankByLogicalColour(
BareCoordinatesByRankByLogicalColour,
CoordinatesByLogicalColour,
CoordinatesByRankByLogicalColour(
deconstruct
),
findPassedPawnCoordinatesByLogicalColour,
findPiecesOfColour,
assocs,
listCoordinates,
getKingsCoordinates,
dereference,
sortCoordinates
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!), (//))
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Abscissa as Cartesian.Abscissa
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
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.PieceSquareValueByCoordinates as Component.PieceSquareValueByCoordinates
import qualified BishBosh.Component.PieceSquareValueByCoordinatesByRank as Component.PieceSquareValueByCoordinatesByRank
import qualified BishBosh.Component.Zobrist as Component.Zobrist
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.SelfValidating as Property.SelfValidating
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.StateProperty.View as StateProperty.View
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.List
import qualified Data.List.Extra
import qualified Data.Map.Strict as Map
import qualified Data.Maybe
type CoordinatesByRank = Attribute.Rank.ArrayByRank [Cartesian.Coordinates.Coordinates]
type BareCoordinatesByRankByLogicalColour = Colour.LogicalColour.ArrayByLogicalColour CoordinatesByRank
newtype CoordinatesByRankByLogicalColour = MkCoordinatesByRankByLogicalColour {
CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct :: BareCoordinatesByRankByLogicalColour
}
instance Control.DeepSeq.NFData CoordinatesByRankByLogicalColour where
rnf :: CoordinatesByRankByLogicalColour -> ()
rnf MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = BareCoordinatesByRankByLogicalColour -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf BareCoordinatesByRankByLogicalColour
byLogicalColour
instance StateProperty.Censor.Censor CoordinatesByRankByLogicalColour where
countPiecesByLogicalColour :: CoordinatesByRankByLogicalColour -> (NPieces, NPieces)
countPiecesByLogicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = ((LogicalColour -> NPieces) -> LogicalColour -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour
Colour.LogicalColour.Black) ((LogicalColour -> NPieces) -> NPieces)
-> ((LogicalColour -> NPieces) -> NPieces)
-> (LogicalColour -> NPieces)
-> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((LogicalColour -> NPieces) -> LogicalColour -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour
Colour.LogicalColour.White) ((LogicalColour -> NPieces) -> (NPieces, NPieces))
-> (LogicalColour -> NPieces) -> (NPieces, NPieces)
forall a b. (a -> b) -> a -> b
$ (NPieces -> [Coordinates] -> NPieces)
-> NPieces -> Array Rank [Coordinates] -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\NPieces
acc -> (NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
acc) (NPieces -> NPieces)
-> ([Coordinates] -> NPieces) -> [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] -> NPieces) -> [Coordinates] -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length) NPieces
0 (Array Rank [Coordinates] -> NPieces)
-> (LogicalColour -> Array Rank [Coordinates])
-> LogicalColour
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
countPieces :: CoordinatesByRankByLogicalColour -> NPieces
countPieces MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = (NPieces -> Array Rank [Coordinates] -> NPieces)
-> NPieces -> BareCoordinatesByRankByLogicalColour -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
(NPieces -> [Coordinates] -> NPieces)
-> NPieces -> Array Rank [Coordinates] -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' ((NPieces -> [Coordinates] -> NPieces)
-> NPieces -> Array Rank [Coordinates] -> NPieces)
-> (NPieces -> [Coordinates] -> NPieces)
-> NPieces
-> Array Rank [Coordinates]
-> NPieces
forall a b. (a -> b) -> a -> b
$ \NPieces
acc -> (NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ NPieces
acc) (NPieces -> NPieces)
-> ([Coordinates] -> NPieces) -> [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] -> NPieces) -> [Coordinates] -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length
) NPieces
0 BareCoordinatesByRankByLogicalColour
byLogicalColour
countPieceDifferenceByRank :: CoordinatesByRankByLogicalColour -> NPiecesByRank
countPieceDifferenceByRank MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = [NPieces] -> NPiecesByRank
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
Attribute.Rank.listArrayByRank ([NPieces] -> NPiecesByRank)
-> ((LogicalColour -> [NPieces]) -> [NPieces])
-> (LogicalColour -> [NPieces])
-> NPiecesByRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NPieces] -> [NPieces] -> [NPieces])
-> ([NPieces], [NPieces]) -> [NPieces]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
(NPieces -> NPieces -> NPieces)
-> [NPieces] -> [NPieces] -> [NPieces]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-)
) (([NPieces], [NPieces]) -> [NPieces])
-> ((LogicalColour -> [NPieces]) -> ([NPieces], [NPieces]))
-> (LogicalColour -> [NPieces])
-> [NPieces]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
((LogicalColour -> [NPieces]) -> LogicalColour -> [NPieces]
forall a b. (a -> b) -> a -> b
$ LogicalColour
Colour.LogicalColour.White) ((LogicalColour -> [NPieces]) -> [NPieces])
-> ((LogicalColour -> [NPieces]) -> [NPieces])
-> (LogicalColour -> [NPieces])
-> ([NPieces], [NPieces])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((LogicalColour -> [NPieces]) -> LogicalColour -> [NPieces]
forall a b. (a -> b) -> a -> b
$ LogicalColour
Colour.LogicalColour.Black)
) ((LogicalColour -> [NPieces]) -> NPiecesByRank)
-> (LogicalColour -> [NPieces]) -> NPiecesByRank
forall a b. (a -> b) -> a -> b
$ ([Coordinates] -> NPieces) -> [[Coordinates]] -> [NPieces]
forall a b. (a -> b) -> [a] -> [b]
map (NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces)
-> ([Coordinates] -> NPieces) -> [Coordinates] -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length) ([[Coordinates]] -> [NPieces])
-> (LogicalColour -> [[Coordinates]]) -> LogicalColour -> [NPieces]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Rank [Coordinates] -> [[Coordinates]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (Array Rank [Coordinates] -> [[Coordinates]])
-> (LogicalColour -> Array Rank [Coordinates])
-> LogicalColour
-> [[Coordinates]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
hasInsufficientMaterial :: CoordinatesByRankByLogicalColour -> Bool
hasInsufficientMaterial MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = (Array Rank [Coordinates] -> Bool)
-> BareCoordinatesByRankByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all (
\Array Rank [Coordinates]
byRank -> (Rank -> Bool) -> [Rank] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
[Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Coordinates] -> Bool) -> (Rank -> [Coordinates]) -> Rank -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates]
byRank Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
) [Rank]
Attribute.Rank.individuallySufficientMaterial
) BareCoordinatesByRankByLogicalColour
byLogicalColour Bool -> Bool -> Bool
&& case [Coordinates]
blackKnights [Coordinates] -> [Coordinates] -> [Coordinates]
forall a. [a] -> [a] -> [a]
++ [Coordinates]
whiteKnights of
[] -> [Coordinates] -> Bool
Cartesian.Coordinates.areSquaresIsochromatic [Coordinates]
bishops
[Coordinates
_] -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Coordinates]
bishops
[Coordinates]
_ -> Bool
False
where
[[Coordinates]
blackKnights, [Coordinates]
blackBishops, [Coordinates]
whiteKnights, [Coordinates]
whiteBishops] = [
Array Rank [Coordinates]
byRank Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank |
Array Rank [Coordinates]
byRank <- BareCoordinatesByRankByLogicalColour -> [Array Rank [Coordinates]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList BareCoordinatesByRankByLogicalColour
byLogicalColour,
Rank
rank <- [Rank
Attribute.Rank.Knight, Rank
Attribute.Rank.Bishop]
]
bishops :: [Coordinates]
bishops = [Coordinates]
blackBishops [Coordinates] -> [Coordinates] -> [Coordinates]
forall a. [a] -> [a] -> [a]
++ [Coordinates]
whiteBishops
hasBothKings :: CoordinatesByRankByLogicalColour -> Bool
hasBothKings MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = (Array Rank [Coordinates] -> Bool)
-> BareCoordinatesByRankByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all ((NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
1) (NPieces -> Bool)
-> (Array Rank [Coordinates] -> NPieces)
-> Array Rank [Coordinates]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length ([Coordinates] -> NPieces)
-> (Array Rank [Coordinates] -> [Coordinates])
-> Array Rank [Coordinates]
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.King)) BareCoordinatesByRankByLogicalColour
byLogicalColour
instance StateProperty.Hashable.Hashable CoordinatesByRankByLogicalColour where
listRandoms :: Zobrist positionHash
-> CoordinatesByRankByLogicalColour -> [positionHash]
listRandoms Zobrist positionHash
zobrist MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = [
Zobrist positionHash -> Index -> positionHash
forall positionHash. Zobrist positionHash -> Index -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour Zobrist positionHash
zobrist (LogicalColour
logicalColour, Rank
rank, Coordinates
coordinates) |
(LogicalColour
logicalColour, Array Rank [Coordinates]
byRank) <- BareCoordinatesByRankByLogicalColour
-> [(LogicalColour, Array Rank [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs BareCoordinatesByRankByLogicalColour
byLogicalColour,
(Rank
rank, [Coordinates]
coordinatesList) <- Array Rank [Coordinates] -> [(Rank, [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs Array Rank [Coordinates]
byRank,
Coordinates
coordinates <- [Coordinates]
coordinatesList
]
instance StateProperty.Mutator.Mutator CoordinatesByRankByLogicalColour where
defineCoordinates :: Maybe Piece
-> Coordinates
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
defineCoordinates Maybe Piece
maybePiece Coordinates
coordinates = BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
MkCoordinatesByRankByLogicalColour (BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour)
-> (CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour)
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
\BareCoordinatesByRankByLogicalColour
byLogicalColour -> BareCoordinatesByRankByLogicalColour
-> (Piece -> BareCoordinatesByRankByLogicalColour)
-> Maybe Piece
-> BareCoordinatesByRankByLogicalColour
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe BareCoordinatesByRankByLogicalColour
byLogicalColour (
\Piece
piece -> let
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece
byRank :: Array Rank [Coordinates]
byRank = BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
in BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> [(LogicalColour, Array Rank [Coordinates])]
-> BareCoordinatesByRankByLogicalColour
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
(
LogicalColour
logicalColour,
Array Rank [Coordinates]
byRank Array Rank [Coordinates]
-> [(Rank, [Coordinates])] -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [
Rank -> Rank
forall a. a -> a
id (Rank -> Rank)
-> (Rank -> [Coordinates]) -> Rank -> (Rank, [Coordinates])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Coordinates
coordinates Coordinates -> [Coordinates] -> [Coordinates]
forall a. a -> [a] -> [a]
:) ([Coordinates] -> [Coordinates])
-> (Rank -> [Coordinates]) -> Rank -> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates]
byRank Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (Rank -> (Rank, [Coordinates])) -> Rank -> (Rank, [Coordinates])
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
piece
]
)
]
) Maybe Piece
maybePiece
) (BareCoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour)
-> (CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour)
-> CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct (CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour)
-> (CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour)
-> CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
purgeCoordinates Coordinates
coordinates
movePiece :: Move
-> MoveType
-> Piece
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
movePiece Move
move MoveType
moveType Piece
sourcePiece MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
MkCoordinatesByRankByLogicalColour (BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour)
-> BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
forall a b. (a -> b) -> a -> b
$ BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> [(LogicalColour, Array Rank [Coordinates])]
-> BareCoordinatesByRankByLogicalColour
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// (
let
deleteOpponentsCoordinates :: Coordinates -> Rank -> (LogicalColour, Array Rank [Coordinates])
deleteOpponentsCoordinates Coordinates
coordinates Rank
rank = LogicalColour -> LogicalColour
forall a. a -> a
id (LogicalColour -> LogicalColour)
-> (LogicalColour -> Array Rank [Coordinates])
-> LogicalColour
-> (LogicalColour, Array Rank [Coordinates])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates
-> Rank -> Array Rank [Coordinates] -> Array Rank [Coordinates]
deleteCoordinatesFromRank Coordinates
coordinates Rank
rank (Array Rank [Coordinates] -> Array Rank [Coordinates])
-> (LogicalColour -> Array Rank [Coordinates])
-> LogicalColour
-> Array Rank [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (LogicalColour -> (LogicalColour, Array Rank [Coordinates]))
-> LogicalColour -> (LogicalColour, Array Rank [Coordinates])
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
in (Bool
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])],
[(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])],
(Maybe Rank, Maybe Rank)
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> MoveType
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall a.
(Bool -> a, a, (Maybe Rank, Maybe Rank) -> a) -> MoveType -> a
Attribute.MoveType.apply (
([(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> Bool
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall a b. a -> b -> a
const [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall a. a -> a
id,
(LogicalColour -> Transformation
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates
destination Coordinates -> Rank -> (LogicalColour, Array Rank [Coordinates])
`deleteOpponentsCoordinates` Rank
Attribute.Rank.Pawn (LogicalColour, Array Rank [Coordinates])
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall a. a -> [a] -> [a]
:),
([(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> (Rank
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> Maybe Rank
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall a. a -> a
id (
(:) ((LogicalColour, Array Rank [Coordinates])
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> (Rank -> (LogicalColour, Array Rank [Coordinates]))
-> Rank
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Rank -> (LogicalColour, Array Rank [Coordinates])
deleteOpponentsCoordinates Coordinates
destination
) (Maybe Rank
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> ((Maybe Rank, Maybe Rank) -> Maybe Rank)
-> (Maybe Rank, Maybe Rank)
-> [(LogicalColour, Array Rank [Coordinates])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Rank, Maybe Rank) -> Maybe Rank
forall a b. (a, b) -> a
fst
) MoveType
moveType
) [
let
byRank :: Array Rank [Coordinates]
byRank = BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
in (
LogicalColour
logicalColour,
Array Rank [Coordinates]
byRank Array Rank [Coordinates]
-> [(Rank, [Coordinates])] -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// ((Rank, [Coordinates]) -> [(Rank, [Coordinates])])
-> (Rank -> (Rank, [Coordinates]) -> [(Rank, [Coordinates])])
-> Maybe Rank
-> (Rank, [Coordinates])
-> [(Rank, [Coordinates])]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
(Rank, [Coordinates]) -> [(Rank, [Coordinates])]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Rank, [Coordinates]) -> [(Rank, [Coordinates])])
-> ((Rank, [Coordinates]) -> (Rank, [Coordinates]))
-> (Rank, [Coordinates])
-> [(Rank, [Coordinates])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Coordinates] -> [Coordinates])
-> (Rank, [Coordinates]) -> (Rank, [Coordinates])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (Coordinates
destination Coordinates -> [Coordinates] -> [Coordinates]
forall a. a -> [a] -> [a]
:)
) (
\Rank
promotionRank -> (:) (
Rank -> Rank
forall a. a -> a
id (Rank -> Rank)
-> (Rank -> [Coordinates]) -> Rank -> (Rank, [Coordinates])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Coordinates
destination Coordinates -> [Coordinates] -> [Coordinates]
forall a. a -> [a] -> [a]
:) ([Coordinates] -> [Coordinates])
-> (Rank -> [Coordinates]) -> Rank -> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates]
byRank Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (Rank -> (Rank, [Coordinates])) -> Rank -> (Rank, [Coordinates])
forall a b. (a -> b) -> a -> b
$ Rank
promotionRank
) ([(Rank, [Coordinates])] -> [(Rank, [Coordinates])])
-> ((Rank, [Coordinates]) -> [(Rank, [Coordinates])])
-> (Rank, [Coordinates])
-> [(Rank, [Coordinates])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, [Coordinates]) -> [(Rank, [Coordinates])]
forall (m :: * -> *) a. Monad m => a -> m a
return
) (
MoveType -> Maybe Rank
Attribute.MoveType.getMaybePromotedRank MoveType
moveType
) (
Rank -> Rank
forall a. a -> a
id (Rank -> Rank)
-> (Rank -> [Coordinates]) -> Rank -> (Rank, [Coordinates])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates -> [Coordinates] -> [Coordinates]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete (Move -> Coordinates
Component.Move.getSource Move
move) ([Coordinates] -> [Coordinates])
-> (Rank -> [Coordinates]) -> Rank -> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates]
byRank Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (Rank -> (Rank, [Coordinates])) -> Rank -> (Rank, [Coordinates])
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
sourcePiece
)
)
] where
destination :: Coordinates
destination = Move -> Coordinates
Component.Move.getDestination Move
move
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece
instance StateProperty.Seeker.Seeker CoordinatesByRankByLogicalColour where
findProximateKnights :: CoordinatesByRankByLogicalColour
-> LogicalColour -> Coordinates -> [Coordinates]
findProximateKnights MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } LogicalColour
logicalColour Coordinates
destination = (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
&& Vector -> Bool
Cartesian.Vector.isKnightsMove (
Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
source Coordinates
destination
)
) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Knight
findPieces :: (Piece -> Bool)
-> CoordinatesByRankByLogicalColour -> [LocatedPiece]
findPieces Piece -> Bool
predicate MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = [
(Coordinates
coordinates, Piece
piece) |
(LogicalColour
logicalColour, Array Rank [Coordinates]
byRank) <- BareCoordinatesByRankByLogicalColour
-> [(LogicalColour, Array Rank [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs BareCoordinatesByRankByLogicalColour
byLogicalColour,
(Rank
rank, [Coordinates]
coordinatesList) <- Array Rank [Coordinates] -> [(Rank, [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs Array Rank [Coordinates]
byRank,
let piece :: Piece
piece = LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank,
Piece -> Bool
predicate Piece
piece,
Coordinates
coordinates <- [Coordinates]
coordinatesList
]
countPawnsByFileByLogicalColour :: CoordinatesByRankByLogicalColour -> NPiecesByFileByLogicalColour
countPawnsByFileByLogicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = (Array Rank [Coordinates] -> NPiecesByFile)
-> BareCoordinatesByRankByLogicalColour
-> NPiecesByFileByLogicalColour
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 (
(NPiecesByFile -> Coordinates -> NPiecesByFile)
-> NPiecesByFile -> [Coordinates] -> NPiecesByFile
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\NPiecesByFile
m Coordinates
coordinates -> NPieces -> NPiecesByFile -> NPiecesByFile
StateProperty.Seeker.accumulatePawnsByFile (Coordinates -> NPieces
Cartesian.Coordinates.getX Coordinates
coordinates) NPiecesByFile
m
) NPiecesByFile
forall a. Empty a => a
Property.Empty.empty ([Coordinates] -> NPiecesByFile)
-> (Array Rank [Coordinates] -> [Coordinates])
-> Array Rank [Coordinates]
-> NPiecesByFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Pawn)
) BareCoordinatesByRankByLogicalColour
byLogicalColour
instance StateProperty.View.View CoordinatesByRankByLogicalColour where
fromAssocs :: [LocatedPiece] -> CoordinatesByRankByLogicalColour
fromAssocs = BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
MkCoordinatesByRankByLogicalColour (BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour)
-> ([LocatedPiece] -> BareCoordinatesByRankByLogicalColour)
-> [LocatedPiece]
-> CoordinatesByRankByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates]
-> Array Rank [Coordinates] -> Array Rank [Coordinates])
-> Array Rank [Coordinates]
-> (LogicalColour, LogicalColour)
-> [(LogicalColour, Array Rank [Coordinates])]
-> BareCoordinatesByRankByLogicalColour
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
Data.Array.IArray.accumArray (
(Array Rank [Coordinates]
-> Array Rank [Coordinates] -> Array Rank [Coordinates])
-> Array Rank [Coordinates]
-> Array Rank [Coordinates]
-> Array Rank [Coordinates]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array Rank [Coordinates]
-> Array Rank [Coordinates] -> Array Rank [Coordinates]
forall a b. a -> b -> a
const
) (
[[Coordinates]] -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Rank e
Attribute.Rank.listArrayByRank ([[Coordinates]] -> Array Rank [Coordinates])
-> [[Coordinates]] -> Array Rank [Coordinates]
forall a b. (a -> b) -> a -> b
$ [Coordinates] -> [[Coordinates]]
forall a. a -> [a]
repeat []
) (LogicalColour
forall a. Bounded a => a
minBound, LogicalColour
forall a. Bounded a => a
maxBound) ([(LogicalColour, Array Rank [Coordinates])]
-> BareCoordinatesByRankByLogicalColour)
-> ([LocatedPiece] -> [(LogicalColour, Array Rank [Coordinates])])
-> [LocatedPiece]
-> BareCoordinatesByRankByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, [(Rank, Coordinates)])
-> (LogicalColour, Array Rank [Coordinates]))
-> [(LogicalColour, [(Rank, Coordinates)])]
-> [(LogicalColour, Array Rank [Coordinates])]
forall a b. (a -> b) -> [a] -> [b]
map (
([(Rank, Coordinates)] -> Array Rank [Coordinates])
-> (LogicalColour, [(Rank, Coordinates)])
-> (LogicalColour, Array Rank [Coordinates])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([(Rank, Coordinates)] -> Array Rank [Coordinates])
-> (LogicalColour, [(Rank, Coordinates)])
-> (LogicalColour, Array Rank [Coordinates]))
-> ([(Rank, Coordinates)] -> Array Rank [Coordinates])
-> (LogicalColour, [(Rank, Coordinates)])
-> (LogicalColour, Array Rank [Coordinates])
forall a b. (a -> b) -> a -> b
$ ([Coordinates] -> [Coordinates] -> [Coordinates])
-> [Coordinates]
-> (Rank, Rank)
-> [(Rank, [Coordinates])]
-> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
Data.Array.IArray.accumArray [Coordinates] -> [Coordinates] -> [Coordinates]
forall a. [a] -> [a] -> [a]
(++) [] (Rank
forall a. Bounded a => a
minBound, Rank
forall a. Bounded a => a
maxBound) ([(Rank, [Coordinates])] -> Array Rank [Coordinates])
-> ([(Rank, Coordinates)] -> [(Rank, [Coordinates])])
-> [(Rank, Coordinates)]
-> Array Rank [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Rank, Coordinates)] -> [(Rank, [Coordinates])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
Data.List.Extra.groupSort
) ([(LogicalColour, [(Rank, Coordinates)])]
-> [(LogicalColour, Array Rank [Coordinates])])
-> ([LocatedPiece] -> [(LogicalColour, [(Rank, Coordinates)])])
-> [LocatedPiece]
-> [(LogicalColour, Array Rank [Coordinates])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LogicalColour, (Rank, Coordinates))]
-> [(LogicalColour, [(Rank, Coordinates)])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
Data.List.Extra.groupSort ([(LogicalColour, (Rank, Coordinates))]
-> [(LogicalColour, [(Rank, Coordinates)])])
-> ([LocatedPiece] -> [(LogicalColour, (Rank, Coordinates))])
-> [LocatedPiece]
-> [(LogicalColour, [(Rank, Coordinates)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocatedPiece -> (LogicalColour, (Rank, Coordinates)))
-> [LocatedPiece] -> [(LogicalColour, (Rank, Coordinates))]
forall a b. (a -> b) -> [a] -> [b]
map (
\(Coordinates
coordinates, Piece
piece) -> (Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece, (Piece -> Rank
Component.Piece.getRank Piece
piece, Coordinates
coordinates))
)
instance Component.Accountant.Accountant CoordinatesByRankByLogicalColour where
sumPieceSquareValueByLogicalColour :: PieceSquareValueByCoordinatesByRank
-> CoordinatesByRankByLogicalColour -> NPieces -> [Base]
sumPieceSquareValueByLogicalColour PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } NPieces
nPieces = ((LogicalColour, Array Rank [Coordinates]) -> Base)
-> [(LogicalColour, Array Rank [Coordinates])] -> [Base]
forall a b. (a -> b) -> [a] -> [b]
map (
\(LogicalColour
logicalColour, Array Rank [Coordinates]
byRank) -> (Base -> (Rank, [Coordinates]) -> Base)
-> Base -> [(Rank, [Coordinates])] -> Base
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Base
acc (Rank
rank, [Coordinates]
coordinatesList) -> let
pieceSquareValueByCoordinates :: PieceSquareValueByCoordinates
pieceSquareValueByCoordinates = PieceSquareValueByCoordinatesByRank
-> NPieces -> Rank -> PieceSquareValueByCoordinates
Component.PieceSquareValueByCoordinatesByRank.getPieceSquareValueByCoordinates PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank NPieces
nPieces Rank
rank
in PieceSquareValueByCoordinates
pieceSquareValueByCoordinates PieceSquareValueByCoordinates -> Base -> Base
`seq` (Base -> Coordinates -> Base) -> Base -> [Coordinates] -> Base
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Base
acc' Coordinates
coordinates -> Base
acc' Base -> Base -> Base
forall a. Num a => a -> a -> a
+ (Base -> Base
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Base -> Base) -> Base -> Base
forall a b. (a -> b) -> a -> b
$! PieceSquareValueByCoordinates
-> LogicalColour -> Coordinates -> Base
Component.PieceSquareValueByCoordinates.getPieceSquareValue PieceSquareValueByCoordinates
pieceSquareValueByCoordinates LogicalColour
logicalColour Coordinates
coordinates)
) Base
acc [Coordinates]
coordinatesList
) Base
0 ([(Rank, [Coordinates])] -> Base)
-> [(Rank, [Coordinates])] -> Base
forall a b. (a -> b) -> a -> b
$ Array Rank [Coordinates] -> [(Rank, [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs Array Rank [Coordinates]
byRank
) ([(LogicalColour, Array Rank [Coordinates])] -> [Base])
-> [(LogicalColour, Array Rank [Coordinates])] -> [Base]
forall a b. (a -> b) -> a -> b
$ BareCoordinatesByRankByLogicalColour
-> [(LogicalColour, Array Rank [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs BareCoordinatesByRankByLogicalColour
byLogicalColour
instance Property.SelfValidating.SelfValidating CoordinatesByRankByLogicalColour where
findInvalidity :: CoordinatesByRankByLogicalColour -> [String]
findInvalidity CoordinatesByRankByLogicalColour
selfValidator = ((CoordinatesByRankByLogicalColour -> [String]) -> [String])
-> [CoordinatesByRankByLogicalColour -> [String]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CoordinatesByRankByLogicalColour -> [String])
-> CoordinatesByRankByLogicalColour -> [String]
forall a b. (a -> b) -> a -> b
$ CoordinatesByRankByLogicalColour
selfValidator) [
CoordinatesByRankByLogicalColour -> [String]
forall censor. Censor censor => censor -> [String]
StateProperty.Censor.findInvalidity,
CoordinatesByRankByLogicalColour -> [String]
forall seeker. Seeker seeker => seeker -> [String]
StateProperty.Seeker.findInvalidity,
[(CoordinatesByRankByLogicalColour -> Bool, String)]
-> CoordinatesByRankByLogicalColour -> [String]
forall selfValidator.
[(selfValidator -> Bool, String)] -> selfValidator -> [String]
Property.SelfValidating.findErrors [
(
Bool -> Bool
not (Bool -> Bool)
-> (CoordinatesByRankByLogicalColour -> Bool)
-> CoordinatesByRankByLogicalColour
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Coordinates] -> Bool) -> [[Coordinates]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
1) (NPieces -> Bool)
-> ([Coordinates] -> NPieces) -> [Coordinates] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length) ([[Coordinates]] -> Bool)
-> (CoordinatesByRankByLogicalColour -> [[Coordinates]])
-> CoordinatesByRankByLogicalColour
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> [[Coordinates]]
forall a. Eq a => [a] -> [[a]]
Data.List.group ([Coordinates] -> [[Coordinates]])
-> (CoordinatesByRankByLogicalColour -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> [[Coordinates]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> [Coordinates]
forall a. Ord a => [a] -> [a]
Data.List.sort ([Coordinates] -> [Coordinates])
-> (CoordinatesByRankByLogicalColour -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRankByLogicalColour -> [Coordinates]
listCoordinates,
String
"there can't be any duplicate coordinates regardless of logical colour or ranks."
)
]
]
dereference
:: CoordinatesByRankByLogicalColour
-> Colour.LogicalColour.LogicalColour
-> Attribute.Rank.Rank
-> [Cartesian.Coordinates.Coordinates]
{-# INLINE dereference #-}
dereference :: CoordinatesByRankByLogicalColour
-> LogicalColour -> Rank -> [Coordinates]
dereference MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } LogicalColour
logicalColour Rank
rank = BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
assocs :: CoordinatesByRankByLogicalColour -> [(Component.Piece.Piece, [Cartesian.Coordinates.Coordinates])]
assocs :: CoordinatesByRankByLogicalColour -> [(Piece, [Coordinates])]
assocs MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = [
(LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank, [Coordinates]
coordinatesList) |
(LogicalColour
logicalColour, Array Rank [Coordinates]
byRank) <- BareCoordinatesByRankByLogicalColour
-> [(LogicalColour, Array Rank [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs BareCoordinatesByRankByLogicalColour
byLogicalColour,
(Rank
rank, [Coordinates]
coordinatesList) <- Array Rank [Coordinates] -> [(Rank, [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs Array Rank [Coordinates]
byRank
]
listCoordinates :: CoordinatesByRankByLogicalColour -> [Cartesian.Coordinates.Coordinates]
listCoordinates :: CoordinatesByRankByLogicalColour -> [Coordinates]
listCoordinates MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = [
Coordinates
coordinates |
Array Rank [Coordinates]
byRank <- BareCoordinatesByRankByLogicalColour -> [Array Rank [Coordinates]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList BareCoordinatesByRankByLogicalColour
byLogicalColour,
[Coordinates]
coordinatesList <- Array Rank [Coordinates] -> [[Coordinates]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Array Rank [Coordinates]
byRank,
Coordinates
coordinates <- [Coordinates]
coordinatesList
]
getKingsCoordinates
:: CoordinatesByRankByLogicalColour
-> Colour.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates
{-# INLINE getKingsCoordinates #-}
getKingsCoordinates :: CoordinatesByRankByLogicalColour -> LogicalColour -> Coordinates
getKingsCoordinates MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } LogicalColour
logicalColour = Coordinates
coordinates where
[Coordinates
coordinates] = BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.King
findPiecesOfColour
:: CoordinatesByRankByLogicalColour
-> Colour.LogicalColour.LogicalColour
-> [Component.Piece.LocatedPiece]
findPiecesOfColour :: CoordinatesByRankByLogicalColour -> LogicalColour -> [LocatedPiece]
findPiecesOfColour MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } LogicalColour
logicalColour = [
(Coordinates
coordinates, LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank) |
(Rank
rank, [Coordinates]
coordinatesList) <- Array Rank [Coordinates] -> [(Rank, [Coordinates])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (Array Rank [Coordinates] -> [(Rank, [Coordinates])])
-> Array Rank [Coordinates] -> [(Rank, [Coordinates])]
forall a b. (a -> b) -> a -> b
$ BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour,
Coordinates
coordinates <- [Coordinates]
coordinatesList
]
advanceDirection :: Colour.LogicalColour.LogicalColour -> Ordering
advanceDirection :: LogicalColour -> Ordering
advanceDirection LogicalColour
Colour.LogicalColour.Black = Ordering
LT
advanceDirection LogicalColour
_ = Ordering
GT
type CoordinatesByLogicalColour = Colour.LogicalColour.ArrayByLogicalColour [Cartesian.Coordinates.Coordinates]
findPassedPawnCoordinatesByLogicalColour :: CoordinatesByRankByLogicalColour -> CoordinatesByLogicalColour
findPassedPawnCoordinatesByLogicalColour :: CoordinatesByRankByLogicalColour -> CoordinatesByLogicalColour
findPassedPawnCoordinatesByLogicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = [[Coordinates]] -> CoordinatesByLogicalColour
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour ([[Coordinates]] -> CoordinatesByLogicalColour)
-> [[Coordinates]] -> CoordinatesByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> [Coordinates])
-> [LogicalColour] -> [[Coordinates]]
forall a b. (a -> b) -> [a] -> [b]
map (
\LogicalColour
logicalColour -> let
opponentsLogicalColour :: LogicalColour
opponentsLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
opposingPawnYByX :: NPiecesByFile
opposingPawnYByX = (NPiecesByFile -> Coordinates -> NPiecesByFile)
-> NPiecesByFile -> [Coordinates] -> NPiecesByFile
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\NPiecesByFile
m Coordinates
coordinates -> (NPieces -> NPieces -> NPiecesByFile -> NPiecesByFile)
-> (NPieces, NPieces) -> NPiecesByFile -> NPiecesByFile
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
(NPieces -> NPieces -> NPieces)
-> NPieces -> NPieces -> NPiecesByFile -> NPiecesByFile
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((NPieces -> NPieces -> NPieces)
-> NPieces -> NPieces -> NPiecesByFile -> NPiecesByFile)
-> (NPieces -> NPieces -> NPieces)
-> NPieces
-> NPieces
-> NPiecesByFile
-> NPiecesByFile
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Colour.LogicalColour.isBlack LogicalColour
opponentsLogicalColour
then NPieces -> NPieces -> NPieces
forall a. Ord a => a -> a -> a
max
else NPieces -> NPieces -> NPieces
forall a. Ord a => a -> a -> a
min
) (
Coordinates -> NPieces
Cartesian.Coordinates.getX (Coordinates -> NPieces)
-> (Coordinates -> NPieces) -> Coordinates -> (NPieces, NPieces)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates -> NPieces
Cartesian.Coordinates.getY (Coordinates -> (NPieces, NPieces))
-> Coordinates -> (NPieces, NPieces)
forall a b. (a -> b) -> a -> b
$ Coordinates
coordinates
) NPiecesByFile
m
) NPiecesByFile
forall a. Empty a => a
Property.Empty.empty ([Coordinates] -> NPiecesByFile) -> [Coordinates] -> NPiecesByFile
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [Coordinates]
findPawns LogicalColour
opponentsLogicalColour
in (Coordinates -> Bool) -> [Coordinates] -> [Coordinates]
forall a. (a -> Bool) -> [a] -> [a]
filter (
\Coordinates
coordinates -> (NPieces -> Bool) -> [NPieces] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
Bool -> (NPieces -> Bool) -> Maybe NPieces -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True (
(
Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour -> Ordering
advanceDirection LogicalColour
logicalColour
) (Ordering -> Bool) -> (NPieces -> Ordering) -> NPieces -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
NPieces -> NPieces -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Coordinates -> NPieces
Cartesian.Coordinates.getY Coordinates
coordinates
)
) (Maybe NPieces -> Bool)
-> (NPieces -> Maybe NPieces) -> NPieces -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPieces -> NPiecesByFile -> Maybe NPieces
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` NPiecesByFile
opposingPawnYByX)
) ([NPieces] -> Bool) -> (NPieces -> [NPieces]) -> NPieces -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NPieces -> [NPieces] -> [NPieces])
-> (NPieces, [NPieces]) -> [NPieces]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((NPieces, [NPieces]) -> [NPieces])
-> (NPieces -> (NPieces, [NPieces])) -> NPieces -> [NPieces]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
NPieces -> NPieces
forall a. a -> a
id (NPieces -> NPieces)
-> (NPieces -> [NPieces]) -> NPieces -> (NPieces, [NPieces])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& NPieces -> [NPieces]
Cartesian.Abscissa.getAdjacents
) (NPieces -> Bool) -> NPieces -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> NPieces
Cartesian.Coordinates.getX Coordinates
coordinates
) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [Coordinates]
findPawns LogicalColour
logicalColour
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members where
findPawns :: LogicalColour -> [Coordinates]
findPawns = (Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Pawn) (Array Rank [Coordinates] -> [Coordinates])
-> (LogicalColour -> Array Rank [Coordinates])
-> LogicalColour
-> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BareCoordinatesByRankByLogicalColour
byLogicalColour BareCoordinatesByRankByLogicalColour
-> LogicalColour -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
deleteCoordinatesFromRank
:: Cartesian.Coordinates.Coordinates
-> Attribute.Rank.Rank
-> CoordinatesByRank
-> CoordinatesByRank
deleteCoordinatesFromRank :: Coordinates
-> Rank -> Array Rank [Coordinates] -> Array Rank [Coordinates]
deleteCoordinatesFromRank Coordinates
coordinates Rank
rank Array Rank [Coordinates]
byRank = Array Rank [Coordinates]
byRank Array Rank [Coordinates]
-> [(Rank, [Coordinates])] -> Array Rank [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [Rank -> Rank
forall a. a -> a
id (Rank -> Rank)
-> (Rank -> [Coordinates]) -> Rank -> (Rank, [Coordinates])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates -> [Coordinates] -> [Coordinates]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Coordinates
coordinates ([Coordinates] -> [Coordinates])
-> (Rank -> [Coordinates]) -> Rank -> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Rank [Coordinates]
byRank Array Rank [Coordinates] -> Rank -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (Rank -> (Rank, [Coordinates])) -> Rank -> (Rank, [Coordinates])
forall a b. (a -> b) -> a -> b
$ Rank
rank]
type Transformation = CoordinatesByRankByLogicalColour -> CoordinatesByRankByLogicalColour
mapCoordinates :: ([Cartesian.Coordinates.Coordinates] -> [Cartesian.Coordinates.Coordinates]) -> Transformation
mapCoordinates :: ([Coordinates] -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
mapCoordinates [Coordinates] -> [Coordinates]
f MkCoordinatesByRankByLogicalColour { deconstruct :: CoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
deconstruct = BareCoordinatesByRankByLogicalColour
byLogicalColour } = BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
MkCoordinatesByRankByLogicalColour (BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour)
-> BareCoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
forall a b. (a -> b) -> a -> b
$ (Array Rank [Coordinates] -> Array Rank [Coordinates])
-> BareCoordinatesByRankByLogicalColour
-> BareCoordinatesByRankByLogicalColour
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 (([Coordinates] -> [Coordinates])
-> Array Rank [Coordinates] -> Array Rank [Coordinates]
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 [Coordinates] -> [Coordinates]
f) BareCoordinatesByRankByLogicalColour
byLogicalColour
purgeCoordinates :: Cartesian.Coordinates.Coordinates -> Transformation
purgeCoordinates :: Coordinates
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
purgeCoordinates Coordinates
coordinates = ([Coordinates] -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
mapCoordinates (([Coordinates] -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour)
-> ([Coordinates] -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Coordinates] -> [Coordinates]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Coordinates
coordinates
sortCoordinates :: Transformation
sortCoordinates :: CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
sortCoordinates = ([Coordinates] -> [Coordinates])
-> CoordinatesByRankByLogicalColour
-> CoordinatesByRankByLogicalColour
mapCoordinates [Coordinates] -> [Coordinates]
forall a. Ord a => [a] -> [a]
Data.List.sort