{-# LANGUAGE CPP, LambdaCase #-}
module BishBosh.Component.Piece(
ArrayByPiece,
LocatedPiece,
Piece(
getLogicalColour,
getRank
),
range,
nPiecesPerSide,
epdCharacterSet,
findAttackDestinations,
showPieces,
getAttackDirections,
promote,
mkBishop,
mkKing,
mkKnight,
mkPawn,
mkPiece,
mkQueen,
mkRook,
listArrayByPiece,
canAttackAlong,
canMoveBetween,
isBlack,
isFriend,
isPawn,
isKnight,
isQueen,
isKing,
isPawnPromotion
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Ordinate as Cartesian.Ordinate
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Direction.Direction as Direction.Direction
import qualified BishBosh.Property.ExtendedPositionDescription as Property.ExtendedPositionDescription
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Type.Count as Type.Count
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Char
import qualified Data.Foldable
import qualified Data.List.Extra
import qualified Data.Map as Map
import qualified Data.Maybe
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Schema
#ifdef USE_PARALLEL
import qualified Control.Parallel.Strategies
#endif
tag :: String
tag :: String
tag = String
"piece"
nPiecesPerSide :: Type.Count.NPieces
nPiecesPerSide :: NPieces
nPiecesPerSide = (NPieces -> NPieces -> NPieces)
-> NPieces -> Array Rank NPieces -> NPieces
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
(+) NPieces
0 Array Rank NPieces
Attribute.Rank.initialAllocationByRankPerSide
data Piece = MkPiece {
Piece -> LogicalColour
getLogicalColour :: Colour.LogicalColour.LogicalColour,
Piece -> Rank
getRank :: Attribute.Rank.Rank
} deriving (Piece
Piece -> Piece -> Bounded Piece
forall a. a -> a -> Bounded a
maxBound :: Piece
$cmaxBound :: Piece
minBound :: Piece
$cminBound :: Piece
Bounded, Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: Piece -> Piece -> Bool
Eq, Eq Piece
Eq Piece
-> (Piece -> Piece -> Ordering)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Piece)
-> (Piece -> Piece -> Piece)
-> Ord Piece
Piece -> Piece -> Bool
Piece -> Piece -> Ordering
Piece -> Piece -> Piece
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Piece -> Piece -> Piece
$cmin :: Piece -> Piece -> Piece
max :: Piece -> Piece -> Piece
$cmax :: Piece -> Piece -> Piece
>= :: Piece -> Piece -> Bool
$c>= :: Piece -> Piece -> Bool
> :: Piece -> Piece -> Bool
$c> :: Piece -> Piece -> Bool
<= :: Piece -> Piece -> Bool
$c<= :: Piece -> Piece -> Bool
< :: Piece -> Piece -> Bool
$c< :: Piece -> Piece -> Bool
compare :: Piece -> Piece -> Ordering
$ccompare :: Piece -> Piece -> Ordering
$cp1Ord :: Eq Piece
Ord)
instance Control.DeepSeq.NFData Piece where
rnf :: Piece -> ()
rnf MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = (LogicalColour, Rank) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (LogicalColour
logicalColour, Rank
rank)
instance Data.Array.IArray.Ix Piece where
range :: (Piece, Piece) -> [Piece]
range (Piece
lower, Piece
upper) = Bool -> [Piece] -> [Piece]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
lower Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Piece
upper Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
maxBound) [Piece]
range
inRange :: (Piece, Piece) -> Piece -> Bool
inRange (Piece
lower, Piece
upper) Piece
piece = Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
piece Piece -> Piece -> Bool
forall a. Ord a => a -> a -> Bool
>= Piece
lower Bool -> Bool -> Bool
&& Piece
piece Piece -> Piece -> Bool
forall a. Ord a => a -> a -> Bool
<= Piece
upper) Bool
True
index :: (Piece, Piece) -> Piece -> NPieces
index (Piece
lower, Piece
upper) MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = Bool -> NPieces -> NPieces
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
lower Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Piece
upper Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
maxBound) (NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour -> NPieces
forall a. Enum a => a -> NPieces
fromEnum LogicalColour
logicalColour NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Attribute.Rank.nDistinctRanks NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ Rank -> NPieces
forall a. Enum a => a -> NPieces
fromEnum Rank
rank
instance Read Piece where
readsPrec :: NPieces -> ReadS Piece
readsPrec NPieces
_ = ReadS Piece
forall a. ReadsFEN a => ReadS a
Property.ForsythEdwards.readsFEN
instance Show Piece where
showsPrec :: NPieces -> Piece -> ShowS
showsPrec NPieces
_ = Piece -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN
epdCharacterSet :: Property.ExtendedPositionDescription.EPD
epdCharacterSet :: String
epdCharacterSet = (Piece -> String) -> [Piece] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece -> String
forall a. ShowsEPD a => a -> String
Property.ExtendedPositionDescription.showEPD [Piece]
range
instance Property.ExtendedPositionDescription.ReadsEPD Piece where
readsEPD :: ReadS Piece
readsEPD String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
c : String
remainder -> (
LogicalColour -> Rank -> Piece
MkPiece (
if Char -> Bool
Data.Char.isUpper Char
c
then LogicalColour
Colour.LogicalColour.White
else LogicalColour
Colour.LogicalColour.Black
) (Rank -> Piece) -> ShowS -> (Rank, String) -> (Piece, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> ShowS
forall a b. a -> b -> a
const String
remainder
) ((Rank, String) -> (Piece, String))
-> [(Rank, String)] -> [(Piece, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS Rank
forall a. Read a => ReadS a
reads [Char
c]
String
_ -> []
instance Property.ExtendedPositionDescription.ShowsEPD Piece where
showsEPD :: Piece -> ShowS
showsEPD piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } = String -> ShowS
showString (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (
if Piece -> Bool
isBlack Piece
piece
then Char -> Char
Data.Char.toLower
else Char -> Char
Data.Char.toUpper
) (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Rank -> String
forall a. Show a => a -> String
show Rank
rank
instance Property.ForsythEdwards.ReadsFEN Piece
instance Property.ForsythEdwards.ShowsFEN Piece
instance HXT.XmlPickler Piece where
xpickle :: PU Piece
xpickle = (String -> Piece, Piece -> String) -> PU String -> PU Piece
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> Piece
forall a. Read a => String -> a
read, Piece -> String
forall a. Show a => a -> String
show) (PU String -> PU Piece)
-> ([String] -> PU String) -> [String] -> PU Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU Piece) -> [String] -> PU Piece
forall a b. (a -> b) -> a -> b
$ (Piece -> String) -> [Piece] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Piece -> String
forall a. Show a => a -> String
show [Piece]
range
instance Property.Opposable.Opposable Piece where
getOpposite :: Piece -> Piece
getOpposite piece :: Piece
piece@MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour
} = Piece
piece {
getLogicalColour :: LogicalColour
getLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
}
range :: [Piece]
range :: [Piece]
range = [
MkPiece :: LogicalColour -> Rank -> Piece
MkPiece {
getLogicalColour :: LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Rank
getRank = Rank
rank
} |
LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
Rank
rank <- [Rank]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
]
showPieces :: String
showPieces :: String
showPieces = (Piece -> String) -> [Piece] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece -> String
forall a. Show a => a -> String
show [Piece]
range
instance Property.FixedMembership.FixedMembership Piece where
members :: [Piece]
members = [Piece]
range
mkPiece :: Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> Piece
mkPiece :: LogicalColour -> Rank -> Piece
mkPiece = LogicalColour -> Rank -> Piece
MkPiece
mkPawn :: Colour.LogicalColour.LogicalColour -> Piece
mkPawn :: LogicalColour -> Piece
mkPawn = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Pawn)
mkRook :: Colour.LogicalColour.LogicalColour -> Piece
mkRook :: LogicalColour -> Piece
mkRook = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Rook)
mkKnight :: Colour.LogicalColour.LogicalColour -> Piece
mkKnight :: LogicalColour -> Piece
mkKnight = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Knight)
mkBishop:: Colour.LogicalColour.LogicalColour -> Piece
mkBishop :: LogicalColour -> Piece
mkBishop = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Bishop)
mkQueen :: Colour.LogicalColour.LogicalColour -> Piece
mkQueen :: LogicalColour -> Piece
mkQueen = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Queen)
mkKing :: Colour.LogicalColour.LogicalColour -> Piece
mkKing :: LogicalColour -> Piece
mkKing = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.King)
promote :: Attribute.Rank.Rank -> Piece -> Piece
promote :: Rank -> Piece -> Piece
promote Rank
newRank Piece
piece
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Piece -> Bool
isPawn Piece
piece = Exception -> Piece
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Piece) -> (String -> Exception) -> String -> Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Component.Piece.promote:\tcan't promote a " (String -> Piece) -> String -> Piece
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
piece String
"."
| Rank
newRank Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rank]
Attribute.Rank.promotionProspects = Exception -> Piece
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Piece) -> (String -> Exception) -> String -> Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Component.Piece.promote:\tcan't promote to a " (String -> Piece) -> String -> Piece
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
newRank String
"."
| Bool
otherwise = Piece
piece { getRank :: Rank
getRank = Rank
newRank }
type ByRankByLogicalColour element = Colour.LogicalColour.ArrayByLogicalColour (Map.Map Attribute.Rank.Rank element)
mkByRankByLogicalColour ::
#ifdef USE_PARALLEL
Control.DeepSeq.NFData element =>
#endif
[Attribute.Rank.Rank] -> (Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element) -> ByRankByLogicalColour element
mkByRankByLogicalColour :: [Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
ranks LogicalColour -> Rank -> element
mkElement = [Map Rank element] -> ByRankByLogicalColour element
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour
#ifdef USE_PARALLEL
([Map Rank element] -> ByRankByLogicalColour element)
-> ([Map Rank element] -> [Map Rank element])
-> [Map Rank element]
-> ByRankByLogicalColour element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy [Map Rank element]
-> [Map Rank element] -> [Map Rank element]
forall a. Strategy a -> a -> a
Control.Parallel.Strategies.withStrategy (Strategy (Map Rank element) -> Strategy [Map Rank element]
forall a. Strategy a -> Strategy [a]
Control.Parallel.Strategies.parList Strategy (Map Rank element)
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq)
#endif
([Map Rank element] -> ByRankByLogicalColour element)
-> [Map Rank element] -> ByRankByLogicalColour element
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> Map Rank element)
-> [LogicalColour] -> [Map Rank element]
forall a b. (a -> b) -> [a] -> [b]
map (
\LogicalColour
logicalColour -> [(Rank, element)] -> Map Rank element
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Rank, element)] -> Map Rank element)
-> [(Rank, element)] -> Map Rank element
forall a b. (a -> b) -> a -> b
$ (Rank -> (Rank, element)) -> [Rank] -> [(Rank, element)]
forall a b. (a -> b) -> [a] -> [b]
map (Rank -> Rank
forall a. a -> a
id (Rank -> Rank) -> (Rank -> element) -> Rank -> (Rank, element)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Rank -> element
mkElement LogicalColour
logicalColour) [Rank]
ranks
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
attackVectorsByRankByLogicalColour :: ByRankByLogicalColour [Cartesian.Vector.Vector]
attackVectorsByRankByLogicalColour :: ByRankByLogicalColour [Vector]
attackVectorsByRankByLogicalColour = [Rank]
-> (LogicalColour -> Rank -> [Vector])
-> ByRankByLogicalColour [Vector]
forall element.
NFData element =>
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.fixedAttackRange ((LogicalColour -> Rank -> [Vector])
-> ByRankByLogicalColour [Vector])
-> (LogicalColour -> Rank -> [Vector])
-> ByRankByLogicalColour [Vector]
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour -> \case
Rank
Attribute.Rank.Pawn -> LogicalColour -> [Vector]
Cartesian.Vector.attackVectorsForPawn LogicalColour
logicalColour
Rank
Attribute.Rank.Knight -> [Vector]
Cartesian.Vector.attackVectorsForKnight
Rank
Attribute.Rank.King -> [Vector]
Cartesian.Vector.attackVectorsForKing
Rank
rank -> String -> [Vector]
forall a. (?callStack::CallStack) => String -> a
error (String -> [Vector]) -> ShowS -> String -> [Vector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Component.Piece.attackVectorsByRankByLogicalColour:\trank must attack over fixed range; " (String -> [Vector]) -> String -> [Vector]
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
rank String
"."
type AttackDestinationsByCoordinatesByRankByLogicalColour = ByRankByLogicalColour (Cartesian.Coordinates.ArrayByCoordinates [Cartesian.Coordinates.Coordinates])
findAttackDestinations'
:: Piece
-> Cartesian.Coordinates.Coordinates
-> [Cartesian.Coordinates.Coordinates]
findAttackDestinations' :: Piece -> Coordinates -> [Coordinates]
findAttackDestinations' MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} Coordinates
source = (Vector -> Maybe Coordinates) -> [Vector] -> [Coordinates]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (
Vector -> Coordinates -> Maybe Coordinates
`Cartesian.Vector.maybeTranslate` Coordinates
source
) (
ByRankByLogicalColour [Vector]
attackVectorsByRankByLogicalColour ByRankByLogicalColour [Vector]
-> LogicalColour -> Map Rank [Vector]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank [Vector] -> Rank -> [Vector]
forall k a. Ord k => Map k a -> k -> a
Map.! Rank
rank
)
attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour
attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour
attackDestinationsByCoordinatesByRankByLogicalColour = [Rank]
-> (LogicalColour -> Rank -> Array Coordinates [Coordinates])
-> AttackDestinationsByCoordinatesByRankByLogicalColour
forall element.
NFData element =>
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.fixedAttackRange ((LogicalColour -> Rank -> Array Coordinates [Coordinates])
-> AttackDestinationsByCoordinatesByRankByLogicalColour)
-> (LogicalColour -> Rank -> Array Coordinates [Coordinates])
-> AttackDestinationsByCoordinatesByRankByLogicalColour
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour Rank
rank -> [[Coordinates]] -> Array Coordinates [Coordinates]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Coordinates e
Cartesian.Coordinates.listArrayByCoordinates ([[Coordinates]] -> Array Coordinates [Coordinates])
-> [[Coordinates]] -> Array Coordinates [Coordinates]
forall a b. (a -> b) -> a -> b
$ (Coordinates -> [Coordinates]) -> [Coordinates] -> [[Coordinates]]
forall a b. (a -> b) -> [a] -> [b]
map (
Piece -> Coordinates -> [Coordinates]
findAttackDestinations' (Piece -> Coordinates -> [Coordinates])
-> Piece -> Coordinates -> [Coordinates]
forall a b. (a -> b) -> a -> b
$! LogicalColour -> Rank -> Piece
mkPiece LogicalColour
logicalColour Rank
rank
) [Coordinates]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
findAttackDestinations
:: Piece
-> Cartesian.Coordinates.Coordinates
-> [Cartesian.Coordinates.Coordinates]
findAttackDestinations :: Piece -> Coordinates -> [Coordinates]
findAttackDestinations MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} Coordinates
coordinates = AttackDestinationsByCoordinatesByRankByLogicalColour
attackDestinationsByCoordinatesByRankByLogicalColour AttackDestinationsByCoordinatesByRankByLogicalColour
-> LogicalColour -> Map Rank (Array Coordinates [Coordinates])
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank (Array Coordinates [Coordinates])
-> Rank -> Array Coordinates [Coordinates]
forall k a. Ord k => Map k a -> k -> a
Map.! Rank
rank Array Coordinates [Coordinates] -> Coordinates -> [Coordinates]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
coordinates
attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Direction.Direction.Direction]
attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Direction]
attackDirectionsByRankByLogicalColour = [Rank]
-> (LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction]
forall element.
NFData element =>
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.earthBound ((LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction])
-> (LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction]
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour -> \case
Rank
Attribute.Rank.Pawn -> LogicalColour -> [Direction]
Direction.Direction.attackDirectionsForPawn LogicalColour
logicalColour
Rank
Attribute.Rank.Bishop -> [Direction]
Direction.Direction.diagonals
Rank
Attribute.Rank.Rook -> [Direction]
Direction.Direction.parallels
Rank
_ -> [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
getAttackDirections :: Piece -> [Direction.Direction.Direction]
getAttackDirections :: Piece -> [Direction]
getAttackDirections MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = ByRankByLogicalColour [Direction]
attackDirectionsByRankByLogicalColour ByRankByLogicalColour [Direction]
-> LogicalColour -> Map Rank [Direction]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank [Direction] -> Rank -> [Direction]
forall k a. Ord k => Map k a -> k -> a
Map.! Rank
rank
canAttackAlong
:: Cartesian.Coordinates.Coordinates
-> Cartesian.Coordinates.Coordinates
-> Piece
-> Bool
canAttackAlong :: Coordinates -> Coordinates -> Piece -> Bool
canAttackAlong Coordinates
source Coordinates
destination Piece
piece = (
case Piece -> Rank
getRank Piece
piece of
Rank
Attribute.Rank.Pawn -> (Vector -> LogicalColour -> Bool
`Cartesian.Vector.isPawnAttack` Piece -> LogicalColour
getLogicalColour Piece
piece)
Rank
Attribute.Rank.Knight -> Vector -> Bool
Cartesian.Vector.isKnightsMove
Rank
Attribute.Rank.Bishop -> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal
Rank
Attribute.Rank.Rook -> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel
Rank
Attribute.Rank.Queen -> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight
Rank
Attribute.Rank.King -> Vector -> Bool
Cartesian.Vector.isKingsMove
) (Vector -> Bool) -> Vector -> Bool
forall a b. (a -> b) -> a -> b
$! Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
source Coordinates
destination
canMoveBetween
:: Piece
-> Cartesian.Coordinates.Coordinates
-> Cartesian.Coordinates.Coordinates
-> Bool
canMoveBetween :: Piece -> Coordinates -> Coordinates -> Bool
canMoveBetween Piece
piece Coordinates
source Coordinates
destination = (
case Piece -> Rank
getRank Piece
piece of
Rank
Attribute.Rank.Pawn -> let
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
getLogicalColour Piece
piece
in (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (Vector -> (Bool, Bool)) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Vector -> LogicalColour -> Bool
`Cartesian.Vector.isPawnAttack` LogicalColour
logicalColour) (Vector -> Bool) -> (Vector -> Bool) -> Vector -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (Vector -> (Bool, Bool)) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0) (NPieces -> Bool) -> (Vector -> NPieces) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector -> NPieces
Cartesian.Vector.getXDistance (Vector -> Bool) -> (Vector -> Bool) -> Vector -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
\case
NPieces
1 -> Bool
True
NPieces
2 -> Coordinates -> LogicalColour -> Bool
Cartesian.Coordinates.isPawnsFirstRank Coordinates
source LogicalColour
logicalColour
NPieces
_ -> Bool
False
) (NPieces -> Bool) -> (Vector -> NPieces) -> Vector -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
if LogicalColour -> Bool
Colour.LogicalColour.isBlack LogicalColour
logicalColour
then NPieces -> NPieces
forall a. Num a => a -> a
negate
else NPieces -> NPieces
forall a. a -> a
id
) (NPieces -> NPieces) -> (Vector -> NPieces) -> Vector -> NPieces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector -> NPieces
Cartesian.Vector.getYDistance
)
)
)
Rank
Attribute.Rank.Knight -> Vector -> Bool
Cartesian.Vector.isKnightsMove
Rank
Attribute.Rank.Bishop -> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal
Rank
Attribute.Rank.Rook -> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel
Rank
Attribute.Rank.Queen -> Vector -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight
Rank
Attribute.Rank.King -> Vector -> Bool
Cartesian.Vector.isKingsMove
) (Vector -> Bool) -> Vector -> Bool
forall a b. (a -> b) -> a -> b
$! Coordinates -> Coordinates -> Vector
Cartesian.Vector.measureDistance Coordinates
source Coordinates
destination
isPawnPromotion
:: Piece
-> Cartesian.Coordinates.Coordinates
-> Bool
isPawnPromotion :: Piece -> Coordinates -> Bool
isPawnPromotion MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Pawn
} Coordinates
destination = LogicalColour -> NPieces
Cartesian.Ordinate.lastRank LogicalColour
logicalColour NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates -> NPieces
Cartesian.Coordinates.getY Coordinates
destination
isPawnPromotion Piece
_ Coordinates
_ = Bool
False
{-# INLINE isBlack #-}
isBlack :: Piece -> Bool
isBlack :: Piece -> Bool
isBlack MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
Colour.LogicalColour.Black } = Bool
True
isBlack Piece
_ = Bool
False
{-# INLINE isFriend #-}
isFriend :: Piece -> Piece -> Bool
isFriend :: Piece -> Piece -> Bool
isFriend MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour } MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour' } = LogicalColour
logicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour'
isPeer :: Piece -> Piece -> Bool
isPeer :: Piece -> Piece -> Bool
isPeer MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank' } = Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
rank'
{-# INLINE isPawn #-}
isPawn :: Piece -> Bool
isPawn :: Piece -> Bool
isPawn MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Pawn } = Bool
True
isPawn Piece
_ = Bool
False
{-# INLINE isKnight #-}
isKnight :: Piece -> Bool
isKnight :: Piece -> Bool
isKnight MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Knight } = Bool
True
isKnight Piece
_ = Bool
False
isBishop :: Piece -> Bool
isBishop :: Piece -> Bool
isBishop MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Bishop } = Bool
True
isBishop Piece
_ = Bool
False
isRook :: Piece -> Bool
isRook :: Piece -> Bool
isRook MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Rook } = Bool
True
isRook Piece
_ = Bool
False
isQueen :: Piece -> Bool
isQueen :: Piece -> Bool
isQueen MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Queen } = Bool
True
isQueen Piece
_ = Bool
False
{-# INLINE isKing #-}
isKing :: Piece -> Bool
isKing :: Piece -> Bool
isKing MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.King } = Bool
True
isKing Piece
_ = Bool
False
type ArrayByPiece = Data.Array.IArray.Array Piece
listArrayByPiece :: Data.Array.IArray.IArray a e => [e] -> a Piece e
listArrayByPiece :: [e] -> a Piece e
listArrayByPiece = (Piece, Piece) -> [e] -> a Piece e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Piece
forall a. Bounded a => a
minBound, Piece
forall a. Bounded a => a
maxBound)
type LocatedPiece = (Cartesian.Coordinates.Coordinates, Piece)