{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module BishBosh.State.CoordinatesByRankByLogicalColour(
NPiecesByFileByLogicalColour,
CoordinatesByLogicalColour,
CoordinatesByRankByLogicalColour(
deconstruct
),
countPawnsByFileByLogicalColour,
findPassedPawnCoordinatesByLogicalColour,
findPiecesOfColour,
sumPieceSquareValueByLogicalColour,
assocs,
listCoordinates,
getKingsCoordinates,
dereference,
fromMaybePieceByCoordinates,
movePiece,
sortCoordinates
) 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.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.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.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.State.MaybePieceByCoordinates as State.MaybePieceByCoordinates
import qualified BishBosh.StateProperty.Censor as StateProperty.Censor
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.Foldable
import qualified Data.List
import qualified Data.Map.Strict
import qualified Data.Maybe
type CoordinatesByRank x y = Attribute.Rank.ArrayByRank [Cartesian.Coordinates.Coordinates x y]
newtype CoordinatesByRankByLogicalColour x y = MkCoordinatesByRankByLogicalColour {
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct :: Attribute.LogicalColour.ArrayByLogicalColour (CoordinatesByRank x y)
}
instance (
Control.DeepSeq.NFData x,
Control.DeepSeq.NFData y
) => Control.DeepSeq.NFData (CoordinatesByRankByLogicalColour x y) where
rnf :: CoordinatesByRankByLogicalColour x y -> ()
rnf MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = ArrayByLogicalColour (CoordinatesByRank x y) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour
instance (Enum x, Enum y) => StateProperty.Censor.Censor (CoordinatesByRankByLogicalColour x y) where
countPiecesByLogicalColour :: CoordinatesByRankByLogicalColour x y -> (NPieces, NPieces)
countPiecesByLogicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = ((LogicalColour -> NPieces) -> LogicalColour -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour
Attribute.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
Attribute.LogicalColour.White) ((LogicalColour -> NPieces) -> (NPieces, NPieces))
-> (LogicalColour -> NPieces) -> (NPieces, NPieces)
forall a b. (a -> b) -> a -> b
$ (NPieces -> [Coordinates x y] -> NPieces)
-> NPieces -> CoordinatesByRank x y -> 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 x y] -> NPieces) -> [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] -> NPieces) -> [Coordinates x y] -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates x y] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length) NPieces
0 (CoordinatesByRank x y -> NPieces)
-> (LogicalColour -> CoordinatesByRank x y)
-> LogicalColour
-> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
countPieces :: CoordinatesByRankByLogicalColour x y -> NPieces
countPieces MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = (NPieces -> CoordinatesByRank x y -> NPieces)
-> NPieces
-> ArrayByLogicalColour (CoordinatesByRank x y)
-> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' (
(NPieces -> [Coordinates x y] -> NPieces)
-> NPieces -> CoordinatesByRank x y -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' ((NPieces -> [Coordinates x y] -> NPieces)
-> NPieces -> CoordinatesByRank x y -> NPieces)
-> (NPieces -> [Coordinates x y] -> NPieces)
-> NPieces
-> CoordinatesByRank x y
-> 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 x y] -> NPieces) -> [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] -> NPieces) -> [Coordinates x y] -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates x y] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length
) NPieces
0 ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour
countPieceDifferenceByRank :: CoordinatesByRankByLogicalColour x y -> NPiecesByRank
countPieceDifferenceByRank MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
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
Attribute.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
Attribute.LogicalColour.Black)
) ((LogicalColour -> [NPieces]) -> NPiecesByRank)
-> (LogicalColour -> [NPieces]) -> NPiecesByRank
forall a b. (a -> b) -> a -> b
$ ([Coordinates x y] -> NPieces) -> [[Coordinates x y]] -> [NPieces]
forall a b. (a -> b) -> [a] -> [b]
map (NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces)
-> ([Coordinates x y] -> NPieces) -> [Coordinates x y] -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates x y] -> NPieces
forall (t :: * -> *) a. Foldable t => t a -> NPieces
length) ([[Coordinates x y]] -> [NPieces])
-> (LogicalColour -> [[Coordinates x y]])
-> LogicalColour
-> [NPieces]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRank x y -> [[Coordinates x y]]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems (CoordinatesByRank x y -> [[Coordinates x y]])
-> (LogicalColour -> CoordinatesByRank x y)
-> LogicalColour
-> [[Coordinates x y]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
hasInsufficientMaterial :: CoordinatesByRankByLogicalColour x y -> Bool
hasInsufficientMaterial MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = (CoordinatesByRank x y -> Bool)
-> ArrayByLogicalColour (CoordinatesByRank x y) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.all (
\CoordinatesByRank x y
byRank -> (Rank -> Bool) -> [Rank] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
[Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Coordinates x y] -> Bool)
-> (Rank -> [Coordinates x y]) -> Rank -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoordinatesByRank x y
byRank CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
) [Rank]
Attribute.Rank.individuallySufficientMaterial
) ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour Bool -> Bool -> Bool
&& case [Coordinates x y]
blackKnights [Coordinates x y] -> [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a] -> [a]
++ [Coordinates x y]
whiteKnights of
[] -> [Coordinates x y] -> Bool
forall x y. (Enum x, Enum y) => [Coordinates x y] -> Bool
Cartesian.Coordinates.areSquaresIsochromatic [Coordinates x y]
bishops
[Coordinates x y
_] -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Coordinates x y]
bishops
[Coordinates x y]
_ -> Bool
False
where
[[Coordinates x y]
blackKnights, [Coordinates x y]
blackBishops, [Coordinates x y]
whiteKnights, [Coordinates x y]
whiteBishops] = [
CoordinatesByRank x y
byRank CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank |
CoordinatesByRank x y
byRank <- ArrayByLogicalColour (CoordinatesByRank x y)
-> [CoordinatesByRank x y]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour,
Rank
rank <- [Rank
Attribute.Rank.Knight, Rank
Attribute.Rank.Bishop]
]
bishops :: [Coordinates x y]
bishops = [Coordinates x y]
blackBishops [Coordinates x y] -> [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a] -> [a]
++ [Coordinates x y]
whiteBishops
hasBothKings :: CoordinatesByRankByLogicalColour x y -> Bool
hasBothKings MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (CoordinatesByRank x y -> Bool)
-> ArrayByLogicalColour (CoordinatesByRank x y) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.any ([Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Coordinates x y] -> Bool)
-> (CoordinatesByRank x y -> [Coordinates x y])
-> CoordinatesByRank x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.King)) ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour
instance (Enum x, Enum y, Ord x, Ord y) => Component.Zobrist.Hashable2D CoordinatesByRankByLogicalColour x y where
listRandoms2D :: CoordinatesByRankByLogicalColour x y
-> Zobrist x y positionHash -> [positionHash]
listRandoms2D MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } Zobrist x y positionHash
zobrist = [
Index x y -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y) =>
Index x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (LogicalColour
logicalColour, Rank
rank, Coordinates x y
coordinates) Zobrist x y positionHash
zobrist |
(LogicalColour
logicalColour, CoordinatesByRank x y
byRank) <- ArrayByLogicalColour (CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour,
(Rank
rank, [Coordinates x y]
coordinatesList) <- CoordinatesByRank x y -> [(Rank, [Coordinates x y])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs CoordinatesByRank x y
byRank,
Coordinates x y
coordinates <- [Coordinates x y]
coordinatesList
]
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => StateProperty.Seeker.Seeker CoordinatesByRankByLogicalColour x y where
{-# SPECIALISE instance StateProperty.Seeker.Seeker CoordinatesByRankByLogicalColour Type.Length.X Type.Length.Y #-}
findProximateKnights :: LogicalColour
-> Coordinates x y
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
findProximateKnights LogicalColour
logicalColour Coordinates x y
destination MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = (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
&& Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isKnightsMove (
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
source Coordinates x y
destination :: Cartesian.Vector.VectorInt
)
) ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Knight
findPieces :: (Piece -> Bool)
-> CoordinatesByRankByLogicalColour x y -> [LocatedPiece x y]
findPieces Piece -> Bool
predicate MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = [
(Coordinates x y
coordinates, Piece
piece) |
(LogicalColour
logicalColour, CoordinatesByRank x y
byRank) <- ArrayByLogicalColour (CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour,
(Rank
rank, [Coordinates x y]
coordinatesList) <- CoordinatesByRank x y -> [(Rank, [Coordinates x y])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs CoordinatesByRank x y
byRank,
let piece :: Piece
piece = LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank,
Piece -> Bool
predicate Piece
piece,
Coordinates x y
coordinates <- [Coordinates x y]
coordinatesList
]
fromMaybePieceByCoordinates :: (
Enum x,
Enum y,
Ord x,
Ord y
) => State.MaybePieceByCoordinates.MaybePieceByCoordinates x y -> CoordinatesByRankByLogicalColour x y
fromMaybePieceByCoordinates :: MaybePieceByCoordinates x y -> CoordinatesByRankByLogicalColour x y
fromMaybePieceByCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates = ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
forall x y.
ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
MkCoordinatesByRankByLogicalColour (ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y)
-> (([(Piece, [Coordinates x y])], [(Piece, [Coordinates x y])])
-> ArrayByLogicalColour (CoordinatesByRank x y))
-> ([(Piece, [Coordinates x y])], [(Piece, [Coordinates x y])])
-> CoordinatesByRankByLogicalColour x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
\([(Piece, [Coordinates x y])]
b, [(Piece, [Coordinates x y])]
w) -> [CoordinatesByRank x y]
-> ArrayByLogicalColour (CoordinatesByRank x y)
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([CoordinatesByRank x y]
-> ArrayByLogicalColour (CoordinatesByRank x y))
-> [CoordinatesByRank x y]
-> ArrayByLogicalColour (CoordinatesByRank x y)
forall a b. (a -> b) -> a -> b
$ ([(Piece, [Coordinates x y])] -> CoordinatesByRank x y)
-> [[(Piece, [Coordinates x y])]] -> [CoordinatesByRank x y]
forall a b. (a -> b) -> [a] -> [b]
map (
([Coordinates x y] -> [Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y]
-> (Rank, Rank)
-> [(Rank, [Coordinates x y])]
-> CoordinatesByRank x y
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 x y] -> [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a] -> [a]
(++) [] (Rank
forall a. Bounded a => a
minBound, Rank
forall a. Bounded a => a
maxBound) ([(Rank, [Coordinates x y])] -> CoordinatesByRank x y)
-> ([(Piece, [Coordinates x y])] -> [(Rank, [Coordinates x y])])
-> [(Piece, [Coordinates x y])]
-> CoordinatesByRank x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Piece, [Coordinates x y]) -> (Rank, [Coordinates x y]))
-> [(Piece, [Coordinates x y])] -> [(Rank, [Coordinates x y])]
forall a b. (a -> b) -> [a] -> [b]
map ((Piece -> Rank)
-> (Piece, [Coordinates x y]) -> (Rank, [Coordinates x y])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first Piece -> Rank
Component.Piece.getRank)
) [[(Piece, [Coordinates x y])]
b, [(Piece, [Coordinates x y])]
w]
) (([(Piece, [Coordinates x y])], [(Piece, [Coordinates x y])])
-> CoordinatesByRankByLogicalColour x y)
-> ([(Piece, [Coordinates x y])], [(Piece, [Coordinates x y])])
-> CoordinatesByRankByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ ((Piece, [Coordinates x y]) -> Bool)
-> [(Piece, [Coordinates x y])]
-> ([(Piece, [Coordinates x y])], [(Piece, [Coordinates x y])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition (
Piece -> Bool
Component.Piece.isBlack (Piece -> Bool)
-> ((Piece, [Coordinates x y]) -> Piece)
-> (Piece, [Coordinates x y])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece, [Coordinates x y]) -> Piece
forall a b. (a, b) -> a
fst
) [
(Piece
piece, [Coordinates x y
coordinates]) |
(Coordinates x y
coordinates, Piece
piece) <- MaybePieceByCoordinates x y -> [(Coordinates x y, Piece)]
forall (seeker :: * -> * -> *) x y.
Seeker seeker x y =>
seeker x y -> [LocatedPiece x y]
StateProperty.Seeker.findAllPieces MaybePieceByCoordinates x y
maybePieceByCoordinates
]
dereference
:: Attribute.LogicalColour.LogicalColour
-> Attribute.Rank.Rank
-> CoordinatesByRankByLogicalColour x y
-> [Cartesian.Coordinates.Coordinates x y]
{-# INLINE dereference #-}
dereference :: LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
dereference LogicalColour
logicalColour Rank
rank MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank
assocs :: CoordinatesByRankByLogicalColour x y -> [(Component.Piece.Piece, [Cartesian.Coordinates.Coordinates x y])]
assocs :: CoordinatesByRankByLogicalColour x y
-> [(Piece, [Coordinates x y])]
assocs MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = [
(LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank, [Coordinates x y]
coordinatesList) |
(LogicalColour
logicalColour, CoordinatesByRank x y
byRank) <- ArrayByLogicalColour (CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour,
(Rank
rank, [Coordinates x y]
coordinatesList) <- CoordinatesByRank x y -> [(Rank, [Coordinates x y])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs CoordinatesByRank x y
byRank
]
listCoordinates :: CoordinatesByRankByLogicalColour x y -> [Cartesian.Coordinates.Coordinates x y]
listCoordinates :: CoordinatesByRankByLogicalColour x y -> [Coordinates x y]
listCoordinates MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = [
Coordinates x y
coordinates |
CoordinatesByRank x y
byRank <- ArrayByLogicalColour (CoordinatesByRank x y)
-> [CoordinatesByRank x y]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour,
[Coordinates x y]
coordinatesList <- CoordinatesByRank x y -> [[Coordinates x y]]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems CoordinatesByRank x y
byRank,
Coordinates x y
coordinates <- [Coordinates x y]
coordinatesList
]
getKingsCoordinates
:: Attribute.LogicalColour.LogicalColour
-> CoordinatesByRankByLogicalColour x y
-> Cartesian.Coordinates.Coordinates x y
{-# INLINE getKingsCoordinates #-}
getKingsCoordinates :: LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
getKingsCoordinates LogicalColour
logicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = Bool -> Coordinates x y -> Coordinates x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Coordinates x y]
coordinates) (Coordinates x y -> Coordinates x y)
-> Coordinates x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ [Coordinates x y] -> Coordinates x y
forall a. [a] -> a
head [Coordinates x y]
coordinates where
coordinates :: [Coordinates x y]
coordinates = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.King
type NPiecesByFileByLogicalColour x = Attribute.LogicalColour.ArrayByLogicalColour (Data.Map.Strict.Map x Type.Count.NPieces)
countPawnsByFileByLogicalColour :: Ord x => CoordinatesByRankByLogicalColour x y -> NPiecesByFileByLogicalColour x
{-# INLINABLE countPawnsByFileByLogicalColour #-}
countPawnsByFileByLogicalColour :: CoordinatesByRankByLogicalColour x y
-> NPiecesByFileByLogicalColour x
countPawnsByFileByLogicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = (CoordinatesByRank x y -> Map x NPieces)
-> ArrayByLogicalColour (CoordinatesByRank x y)
-> NPiecesByFileByLogicalColour x
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 (
(Map x NPieces -> Coordinates x y -> Map x NPieces)
-> Map x NPieces -> [Coordinates x y] -> Map x NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Map x NPieces
m Coordinates x y
coordinates -> (NPieces -> NPieces -> NPieces)
-> x -> NPieces -> Map x NPieces -> Map x NPieces
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.Strict.insertWith ((NPieces -> NPieces) -> NPieces -> NPieces -> NPieces
forall a b. a -> b -> a
const NPieces -> NPieces
forall a. Enum a => a -> a
succ) (Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
coordinates) NPieces
1 Map x NPieces
m
) Map x NPieces
forall k a. Map k a
Data.Map.Strict.empty ([Coordinates x y] -> Map x NPieces)
-> (CoordinatesByRank x y -> [Coordinates x y])
-> CoordinatesByRank x y
-> Map x NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Pawn)
) ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour
findPiecesOfColour
:: Attribute.LogicalColour.LogicalColour
-> CoordinatesByRankByLogicalColour x y
-> [Component.Piece.LocatedPiece x y]
findPiecesOfColour :: LogicalColour
-> CoordinatesByRankByLogicalColour x y -> [LocatedPiece x y]
findPiecesOfColour LogicalColour
logicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = [
(Coordinates x y
coordinates, LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank) |
(Rank
rank, [Coordinates x y]
coordinatesList) <- CoordinatesByRank x y -> [(Rank, [Coordinates x y])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs (CoordinatesByRank x y -> [(Rank, [Coordinates x y])])
-> CoordinatesByRank x y -> [(Rank, [Coordinates x y])]
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour,
Coordinates x y
coordinates <- [Coordinates x y]
coordinatesList
]
type CoordinatesByLogicalColour x y = Attribute.LogicalColour.ArrayByLogicalColour [Cartesian.Coordinates.Coordinates x y]
findPassedPawnCoordinatesByLogicalColour :: (Enum x, Ord x, Ord y) => CoordinatesByRankByLogicalColour x y -> CoordinatesByLogicalColour x y
findPassedPawnCoordinatesByLogicalColour :: CoordinatesByRankByLogicalColour x y
-> CoordinatesByLogicalColour x y
findPassedPawnCoordinatesByLogicalColour MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = [[Coordinates x y]] -> CoordinatesByLogicalColour x y
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([[Coordinates x y]] -> CoordinatesByLogicalColour x y)
-> [[Coordinates x y]] -> CoordinatesByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> [Coordinates x y])
-> [LogicalColour] -> [[Coordinates x y]]
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 :: Map x y
opposingPawnYByX = (Map x y -> Coordinates x y -> Map x y)
-> Map x y -> [Coordinates x y] -> Map x y
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Map x y
m Coordinates x y
coordinates -> (x -> y -> Map x y -> Map x y) -> (x, y) -> Map x y -> Map x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
(y -> y -> y) -> x -> y -> Map x y -> Map x y
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.Strict.insertWith ((y -> y -> y) -> x -> y -> Map x y -> Map x y)
-> (y -> y -> y) -> x -> y -> Map x y -> Map x y
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
opponentsLogicalColour
then y -> y -> y
forall a. Ord a => a -> a -> a
max
else y -> y -> y
forall a. Ord a => a -> a -> a
min
) (
Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX (Coordinates x y -> x)
-> (Coordinates x y -> y) -> Coordinates x y -> (x, y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY (Coordinates x y -> (x, y)) -> Coordinates x y -> (x, y)
forall a b. (a -> b) -> a -> b
$ Coordinates x y
coordinates
) Map x y
m
) Map x y
forall k a. Map k a
Data.Map.Strict.empty ([Coordinates x y] -> Map x y) -> [Coordinates x y] -> Map x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [Coordinates x y]
findPawns LogicalColour
opponentsLogicalColour
in (Coordinates x y -> Bool) -> [Coordinates x y] -> [Coordinates x y]
forall a. (a -> Bool) -> [a] -> [a]
filter (
\Coordinates x y
coordinates -> (x -> Bool) -> [x] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
Bool -> (y -> Bool) -> Maybe y -> 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
Attribute.Direction.advanceDirection LogicalColour
logicalColour
) (Ordering -> Bool) -> (y -> Ordering) -> y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
y -> y -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY Coordinates x y
coordinates
)
) (Maybe y -> Bool) -> (x -> Maybe y) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Map x y -> Maybe y
forall k a. Ord k => k -> Map k a -> Maybe a
`Data.Map.Strict.lookup` Map x y
opposingPawnYByX)
) ([x] -> Bool) -> (x -> [x]) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> [x] -> [x]) -> (x, [x]) -> [x]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((x, [x]) -> [x]) -> (x -> (x, [x])) -> x -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
x -> x
forall a. a -> a
id (x -> x) -> (x -> [x]) -> x -> (x, [x])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& x -> [x]
forall x. (Enum x, Eq x) => x -> [x]
Cartesian.Abscissa.getAdjacents
) (x -> Bool) -> x -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
coordinates
) ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [Coordinates x y]
findPawns LogicalColour
logicalColour
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members where
findPawns :: LogicalColour -> [Coordinates x y]
findPawns = (CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Pawn) (CoordinatesByRank x y -> [Coordinates x y])
-> (LogicalColour -> CoordinatesByRank x y)
-> LogicalColour
-> [Coordinates x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
sumPieceSquareValueByLogicalColour
:: (Num pieceSquareValue)
=> Component.PieceSquareByCoordinatesByRank.FindPieceSquareValues x y pieceSquareValue
-> CoordinatesByRankByLogicalColour x y
-> [pieceSquareValue]
{-# SPECIALISE sumPieceSquareValueByLogicalColour :: Component.PieceSquareByCoordinatesByRank.FindPieceSquareValues Type.Length.X Type.Length.Y Type.Mass.PieceSquareValue -> CoordinatesByRankByLogicalColour Type.Length.X Type.Length.Y -> [Type.Mass.PieceSquareValue] #-}
sumPieceSquareValueByLogicalColour :: FindPieceSquareValues x y pieceSquareValue
-> CoordinatesByRankByLogicalColour x y -> [pieceSquareValue]
sumPieceSquareValueByLogicalColour FindPieceSquareValues x y pieceSquareValue
findPieceSquareValues MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = ((LogicalColour, CoordinatesByRank x y) -> pieceSquareValue)
-> [(LogicalColour, CoordinatesByRank x y)] -> [pieceSquareValue]
forall a b. (a -> b) -> [a] -> [b]
map (
\(LogicalColour
logicalColour, CoordinatesByRank x y
byRank) -> (pieceSquareValue -> (Rank, [Coordinates x y]) -> pieceSquareValue)
-> pieceSquareValue
-> [(Rank, [Coordinates x y])]
-> pieceSquareValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\pieceSquareValue
acc -> (pieceSquareValue -> pieceSquareValue -> pieceSquareValue)
-> pieceSquareValue -> [pieceSquareValue] -> pieceSquareValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' pieceSquareValue -> pieceSquareValue -> pieceSquareValue
forall a. Num a => a -> a -> a
(+) pieceSquareValue
acc ([pieceSquareValue] -> pieceSquareValue)
-> ((Rank, [Coordinates x y]) -> [pieceSquareValue])
-> (Rank, [Coordinates x y])
-> pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank -> [Coordinates x y] -> [pieceSquareValue])
-> (Rank, [Coordinates x y]) -> [pieceSquareValue]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FindPieceSquareValues x y pieceSquareValue
findPieceSquareValues LogicalColour
logicalColour)
) pieceSquareValue
0 ([(Rank, [Coordinates x y])] -> pieceSquareValue)
-> [(Rank, [Coordinates x y])] -> pieceSquareValue
forall a b. (a -> b) -> a -> b
$ CoordinatesByRank x y -> [(Rank, [Coordinates x y])]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs CoordinatesByRank x y
byRank
) ([(LogicalColour, CoordinatesByRank x y)] -> [pieceSquareValue])
-> [(LogicalColour, CoordinatesByRank x y)] -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour (CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour
type Transformation x y = CoordinatesByRankByLogicalColour x y -> CoordinatesByRankByLogicalColour x y
deleteCoordinates
:: (Eq x, Eq y)
=> Cartesian.Coordinates.Coordinates x y
-> Attribute.Rank.Rank
-> CoordinatesByRank x y
-> CoordinatesByRank x y
deleteCoordinates :: Coordinates x y
-> Rank -> CoordinatesByRank x y -> CoordinatesByRank x y
deleteCoordinates Coordinates x y
coordinates Rank
rank CoordinatesByRank x y
byRank = CoordinatesByRank x y
byRank CoordinatesByRank x y
-> [(Rank, [Coordinates x y])] -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(Rank
rank, Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Coordinates x y
coordinates ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ CoordinatesByRank x y
byRank CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
rank)]
movePiece
:: (Eq x, Eq y)
=> Component.Move.Move x y
-> Component.Piece.Piece
-> Maybe Attribute.Rank.Rank
-> Either (Cartesian.Coordinates.Coordinates x y) (Maybe Attribute.Rank.Rank)
-> Transformation x y
movePiece :: Move x y
-> Piece
-> Maybe Rank
-> Either (Coordinates x y) (Maybe Rank)
-> Transformation x y
movePiece Move x y
move Piece
sourcePiece Maybe Rank
maybePromotionRank Either (Coordinates x y) (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
forall x y.
ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
MkCoordinatesByRankByLogicalColour (ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y)
-> ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
-> ArrayByLogicalColour (CoordinatesByRank x y)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// (
(:) ((LogicalColour, CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> (Coordinates x y -> (LogicalColour, CoordinatesByRank x y))
-> Coordinates x y
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Rank -> (LogicalColour, CoordinatesByRank x y)
`deleteOpponentsCoordinates` Rank
Attribute.Rank.Pawn) (Coordinates x y
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> (Maybe Rank
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> Either (Coordinates x y) (Maybe Rank)
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)]
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| ([(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> (Rank
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> Maybe Rank
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)]
forall a. a -> a
id (
(:) ((LogicalColour, CoordinatesByRank x y)
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> (Rank -> (LogicalColour, CoordinatesByRank x y))
-> Rank
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> Rank -> (LogicalColour, CoordinatesByRank x y)
deleteOpponentsCoordinates Coordinates x y
destination
) (Either (Coordinates x y) (Maybe Rank)
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)])
-> Either (Coordinates x y) (Maybe Rank)
-> [(LogicalColour, CoordinatesByRank x y)]
-> [(LogicalColour, CoordinatesByRank x y)]
forall a b. (a -> b) -> a -> b
$ Either (Coordinates x y) (Maybe Rank)
eitherPassingPawnsDestinationOrMaybeTakenRank
) [
let
byRank :: CoordinatesByRank x y
byRank = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour
in (
LogicalColour
logicalColour,
CoordinatesByRank x y
byRank CoordinatesByRank x y
-> [(Rank, [Coordinates x y])] -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// ((Rank, [Coordinates x y]) -> [(Rank, [Coordinates x y])])
-> (Rank
-> (Rank, [Coordinates x y]) -> [(Rank, [Coordinates x y])])
-> Maybe Rank
-> (Rank, [Coordinates x y])
-> [(Rank, [Coordinates x y])]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
(Rank, [Coordinates x y]) -> [(Rank, [Coordinates x y])]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Rank, [Coordinates x y]) -> [(Rank, [Coordinates x y])])
-> ((Rank, [Coordinates x y]) -> (Rank, [Coordinates x y]))
-> (Rank, [Coordinates x y])
-> [(Rank, [Coordinates x y])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Coordinates x y] -> [Coordinates x y])
-> (Rank, [Coordinates x y]) -> (Rank, [Coordinates x y])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (Coordinates x y
destination Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. a -> [a] -> [a]
:)
) (
\Rank
promotionRank -> (:) (
Rank
promotionRank,
Coordinates x y
destination Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. a -> [a] -> [a]
: CoordinatesByRank x y
byRank CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
promotionRank
) ([(Rank, [Coordinates x y])] -> [(Rank, [Coordinates x y])])
-> ((Rank, [Coordinates x y]) -> [(Rank, [Coordinates x y])])
-> (Rank, [Coordinates x y])
-> [(Rank, [Coordinates x y])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, [Coordinates x y]) -> [(Rank, [Coordinates x y])]
forall (m :: * -> *) a. Monad m => a -> m a
return
) Maybe Rank
maybePromotionRank (
Rank -> Rank
forall a. a -> a
id (Rank -> Rank)
-> (Rank -> [Coordinates x y]) -> Rank -> (Rank, [Coordinates x y])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete (Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move) ([Coordinates x y] -> [Coordinates x y])
-> (Rank -> [Coordinates x y]) -> Rank -> [Coordinates x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoordinatesByRank x y
byRank CoordinatesByRank x y -> Rank -> [Coordinates x y]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (Rank -> (Rank, [Coordinates x y]))
-> Rank -> (Rank, [Coordinates x y])
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
sourcePiece
)
)
] where
destination :: Coordinates x y
destination = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece
deleteOpponentsCoordinates :: Coordinates x y -> Rank -> (LogicalColour, CoordinatesByRank x y)
deleteOpponentsCoordinates Coordinates x y
coordinates Rank
rank = LogicalColour -> LogicalColour
forall a. a -> a
id (LogicalColour -> LogicalColour)
-> (LogicalColour -> CoordinatesByRank x y)
-> LogicalColour
-> (LogicalColour, CoordinatesByRank x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Coordinates x y
-> Rank -> CoordinatesByRank x y -> CoordinatesByRank x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y
-> Rank -> CoordinatesByRank x y -> CoordinatesByRank x y
deleteCoordinates Coordinates x y
coordinates Rank
rank (CoordinatesByRank x y -> CoordinatesByRank x y)
-> (LogicalColour -> CoordinatesByRank x y)
-> LogicalColour
-> CoordinatesByRank x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour ArrayByLogicalColour (CoordinatesByRank x y)
-> LogicalColour -> CoordinatesByRank x y
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) (LogicalColour -> (LogicalColour, CoordinatesByRank x y))
-> LogicalColour -> (LogicalColour, CoordinatesByRank x y)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
sortCoordinates :: (Ord x, Ord y) => Transformation x y
sortCoordinates :: Transformation x y
sortCoordinates MkCoordinatesByRankByLogicalColour { deconstruct :: forall x y.
CoordinatesByRankByLogicalColour x y
-> ArrayByLogicalColour (CoordinatesByRank x y)
deconstruct = ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour } = ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
forall x y.
ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
MkCoordinatesByRankByLogicalColour (ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y)
-> ArrayByLogicalColour (CoordinatesByRank x y)
-> CoordinatesByRankByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ (CoordinatesByRank x y -> CoordinatesByRank x y)
-> ArrayByLogicalColour (CoordinatesByRank x y)
-> ArrayByLogicalColour (CoordinatesByRank x y)
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 x y] -> [Coordinates x y])
-> CoordinatesByRank x y -> CoordinatesByRank x y
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 x y] -> [Coordinates x y]
forall a. Ord a => [a] -> [a]
Data.List.sort) ArrayByLogicalColour (CoordinatesByRank x y)
byLogicalColour