{-# LANGUAGE CPP #-}
module BishBosh.State.MaybePieceByCoordinates(
MaybePieceByCoordinates(),
inferMoveType,
findBlockingPiece,
findBlockingPieces,
findAttackerInDirection,
findAttackerInDirections,
listDestinationsFor,
show2D,
dereference,
isVacant,
isOccupied,
isClear,
isObstructed,
isEnPassantMove
) where
import Control.Applicative((<|>))
import Control.Arrow((&&&), (***))
import Control.Category((>>>))
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.Ordinate as Cartesian.Ordinate
import qualified BishBosh.Colour.ANSIColourCode as Colour.ANSIColourCode
import qualified BishBosh.Colour.ColourScheme as Colour.ColourScheme
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
import qualified BishBosh.Colour.LogicalColourOfSquare as Colour.LogicalColourOfSquare
import qualified BishBosh.Colour.PhysicalColour as Colour.PhysicalColour
import qualified BishBosh.Component.Accountant as Component.Accountant
import qualified BishBosh.Component.CastlingMove as Component.CastlingMove
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.Data.Exception as Data.Exception
import qualified BishBosh.Direction.Direction as Direction.Direction
import qualified BishBosh.Notation.Figurine as Notation.Figurine
import qualified BishBosh.Property.Empty as Property.Empty
import qualified BishBosh.Property.ExtendedPositionDescription as Property.ExtendedPositionDescription
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.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 BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Char
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List
import qualified Data.List.Extra
import qualified Data.Maybe
import qualified ToolShed.Data.List.Runlength
#ifdef USE_ARRAY_UNSAFEAT
import qualified Data.Array.Base
#else
import qualified BishBosh.Property.Orientated as Property.Orientated
#endif
newtype MaybePieceByCoordinates = MkMaybePieceByCoordinates {
MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct :: Cartesian.Coordinates.ArrayByCoordinates (Maybe Component.Piece.Piece)
} deriving (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
(MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool)
-> (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool)
-> Eq MaybePieceByCoordinates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
$c/= :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
== :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
$c== :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
Eq, Eq MaybePieceByCoordinates
Eq MaybePieceByCoordinates
-> (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Ordering)
-> (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool)
-> (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool)
-> (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool)
-> (MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool)
-> (MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates)
-> (MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates)
-> Ord MaybePieceByCoordinates
MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
MaybePieceByCoordinates -> MaybePieceByCoordinates -> Ordering
MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates
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 :: MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates
$cmin :: MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates
max :: MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates
$cmax :: MaybePieceByCoordinates
-> MaybePieceByCoordinates -> MaybePieceByCoordinates
>= :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
$c>= :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
> :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
$c> :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
<= :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
$c<= :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
< :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
$c< :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Bool
compare :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Ordering
$ccompare :: MaybePieceByCoordinates -> MaybePieceByCoordinates -> Ordering
$cp1Ord :: Eq MaybePieceByCoordinates
Ord)
listToRaster :: [a] -> [[a]]
listToRaster :: [a] -> [[a]]
listToRaster = Int -> [a] -> [[a]]
forall a. Partial => Int -> [a] -> [[a]]
Data.List.Extra.chunksOf (Int -> [a] -> [[a]]) -> Int -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength
instance Read MaybePieceByCoordinates where
readsPrec :: Int -> ReadS MaybePieceByCoordinates
readsPrec Int
_ = ReadS MaybePieceByCoordinates
forall a. ReadsFEN a => ReadS a
Property.ForsythEdwards.readsFEN
instance Show MaybePieceByCoordinates where
showsPrec :: Int -> MaybePieceByCoordinates -> ShowS
showsPrec Int
_ = MaybePieceByCoordinates -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN
instance Property.ExtendedPositionDescription.ReadsEPD MaybePieceByCoordinates where
readsEPD :: ReadS MaybePieceByCoordinates
readsEPD String
s
| [[Maybe Piece]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Maybe Piece]]
rows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Ordinate.yLength Bool -> Bool -> Bool
|| ([Maybe Piece] -> Bool) -> [[Maybe Piece]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength) (Int -> Bool) -> ([Maybe Piece] -> Int) -> [Maybe Piece] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Piece] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
) [[Maybe Piece]]
rows = []
| Bool
otherwise = [(ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ([[Maybe Piece]] -> ArrayByCoordinates (Maybe Piece))
-> [[Maybe Piece]]
-> MaybePieceByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Piece] -> ArrayByCoordinates (Maybe Piece)
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Coordinates e
Cartesian.Coordinates.listArrayByCoordinates ([Maybe Piece] -> ArrayByCoordinates (Maybe Piece))
-> ([[Maybe Piece]] -> [Maybe Piece])
-> [[Maybe Piece]]
-> ArrayByCoordinates (Maybe Piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe Piece]] -> [Maybe Piece]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe Piece]] -> MaybePieceByCoordinates)
-> [[Maybe Piece]] -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ [[Maybe Piece]] -> [[Maybe Piece]]
forall a. [a] -> [a]
reverse [[Maybe Piece]]
rows, String
remainder)]
where
([[Maybe Piece]]
rows, String
remainder) = (String -> [[Maybe Piece]])
-> (String, String) -> ([[Maybe Piece]], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
(String -> [Maybe Piece]) -> [String] -> [[Maybe Piece]]
forall a b. (a -> b) -> [a] -> [b]
map (
(Char -> [Maybe Piece]) -> String -> [Maybe Piece]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (
\Char
c -> case ReadS Int
forall a. Read a => ReadS a
reads [Char
c] of
[(Int
i, String
"")] -> Int -> Maybe Piece -> [Maybe Piece]
forall a. Int -> a -> [a]
replicate Int
i Maybe Piece
forall a. Maybe a
Nothing
[(Int, String)]
_ -> [Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
piece | (Piece
piece, []) <- ReadS Piece
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD [Char
c]]
)
) ([String] -> [[Maybe Piece]])
-> (String -> [String]) -> String -> [[Maybe Piece]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
Text.ShowList.splitOn (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
Property.ExtendedPositionDescription.rankSeparator)
) ((String, String) -> ([[Maybe Piece]], String))
-> (String -> (String, String))
-> String
-> ([[Maybe Piece]], String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (
Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (
Char
Property.ExtendedPositionDescription.rankSeparator Char -> ShowS
forall a. a -> [a] -> [a]
: String
Component.Piece.epdCharacterSet String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> String
forall a. Show a => a -> String
show [Int
1 .. Int
Cartesian.Abscissa.xLength]
)
) (String -> ([[Maybe Piece]], String))
-> String -> ([[Maybe Piece]], String)
forall a b. (a -> b) -> a -> b
$ ShowS
Data.List.Extra.trimStart String
s
instance Property.ExtendedPositionDescription.ShowsEPD MaybePieceByCoordinates where
showsEPD :: MaybePieceByCoordinates -> ShowS
showsEPD MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (
>>>
) ([ShowS] -> ShowS)
-> ([Maybe Piece] -> [ShowS]) -> [Maybe Piece] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
Data.List.intersperse (
Char -> ShowS
showChar Char
Property.ExtendedPositionDescription.rankSeparator
) ([ShowS] -> [ShowS])
-> ([Maybe Piece] -> [ShowS]) -> [Maybe Piece] -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe Piece] -> ShowS) -> [[Maybe Piece]] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (
(ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([ShowS] -> ShowS)
-> ([Maybe Piece] -> [ShowS]) -> [Maybe Piece] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe Piece) -> [ShowS]) -> [(Int, Maybe Piece)] -> [ShowS]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (
\(Int
runLength, Maybe Piece
maybePiece) -> [ShowS] -> (Piece -> [ShowS]) -> Maybe Piece -> [ShowS]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [
Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
runLength
] (
Int -> ShowS -> [ShowS]
forall a. Int -> a -> [a]
replicate Int
runLength (ShowS -> [ShowS]) -> (Piece -> ShowS) -> Piece -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD
) Maybe Piece
maybePiece
) ([(Int, Maybe Piece)] -> [ShowS])
-> ([Maybe Piece] -> [(Int, Maybe Piece)])
-> [Maybe Piece]
-> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Piece] -> [(Int, Maybe Piece)]
forall a. Eq a => [a] -> [Code a]
ToolShed.Data.List.Runlength.encode
) ([[Maybe Piece]] -> [ShowS])
-> ([Maybe Piece] -> [[Maybe Piece]]) -> [Maybe Piece] -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Piece] -> [[Maybe Piece]]
forall a. [a] -> [[a]]
listToRaster ([Maybe Piece] -> ShowS) -> [Maybe Piece] -> ShowS
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece) -> [Maybe Piece]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList ArrayByCoordinates (Maybe Piece)
byCoordinates
instance Property.ForsythEdwards.ReadsFEN MaybePieceByCoordinates
instance Property.ForsythEdwards.ShowsFEN MaybePieceByCoordinates
instance Data.Default.Default MaybePieceByCoordinates where
def :: MaybePieceByCoordinates
def = String -> MaybePieceByCoordinates
forall a. ReadsFEN a => String -> a
Property.ForsythEdwards.readFEN (String -> MaybePieceByCoordinates)
-> ([String] -> String) -> [String] -> MaybePieceByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
Data.List.intercalate [Char
Property.ExtendedPositionDescription.rankSeparator] ([String] -> MaybePieceByCoordinates)
-> [String] -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ ((LogicalColour -> String) -> String)
-> [LogicalColour -> String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((LogicalColour -> String) -> LogicalColour -> String
forall a b. (a -> b) -> a -> b
$ LogicalColour
Colour.LogicalColour.Black) [
LogicalColour -> String
showNobility,
LogicalColour -> String
showPawnRow
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
4 String
"8" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((LogicalColour -> String) -> String)
-> [LogicalColour -> String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((LogicalColour -> String) -> LogicalColour -> String
forall a b. (a -> b) -> a -> b
$ LogicalColour
Colour.LogicalColour.White) [
LogicalColour -> String
showPawnRow,
LogicalColour -> String
showNobility
] where
showPieces :: [Component.Piece.Piece] -> String
showPieces :: [Piece] -> String
showPieces = (Piece -> String) -> [Piece] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece -> String
forall a. ShowsFEN a => a -> String
Property.ForsythEdwards.showFEN
showPawnRow, showNobility :: Colour.LogicalColour.LogicalColour -> String
showPawnRow :: LogicalColour -> String
showPawnRow LogicalColour
logicalColour = [Piece] -> String
showPieces ([Piece] -> String) -> (Piece -> [Piece]) -> Piece -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Piece -> [Piece]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength) (Piece -> String) -> Piece -> String
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour
showNobility :: LogicalColour -> String
showNobility LogicalColour
logicalColour = [Piece] -> String
showPieces ([Piece] -> String) -> [Piece] -> String
forall a b. (a -> b) -> a -> b
$ (Rank -> Piece) -> [Rank] -> [Piece]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour) [Rank]
Attribute.Rank.nobility
instance Property.Reflectable.ReflectableOnX MaybePieceByCoordinates where
reflectOnX :: MaybePieceByCoordinates -> MaybePieceByCoordinates
reflectOnX MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ([(Coordinates, Maybe Piece)]
-> ArrayByCoordinates (Maybe Piece))
-> [(Coordinates, Maybe Piece)]
-> MaybePieceByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, Maybe Piece)] -> ArrayByCoordinates (Maybe Piece)
forall (a :: * -> * -> *) e.
IArray a e =>
[(Coordinates, e)] -> a Coordinates e
Cartesian.Coordinates.arrayByCoordinates ([(Coordinates, Maybe Piece)] -> ArrayByCoordinates (Maybe Piece))
-> ([(Coordinates, Maybe Piece)] -> [(Coordinates, Maybe Piece)])
-> [(Coordinates, Maybe Piece)]
-> ArrayByCoordinates (Maybe Piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates, Maybe Piece) -> (Coordinates, Maybe Piece))
-> [(Coordinates, Maybe Piece)] -> [(Coordinates, Maybe Piece)]
forall a b. (a -> b) -> [a] -> [b]
map (
Coordinates -> Coordinates
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX (Coordinates -> Coordinates)
-> (Maybe Piece -> Maybe Piece)
-> (Coordinates, Maybe Piece)
-> (Coordinates, Maybe Piece)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Piece -> Piece) -> Maybe Piece -> Maybe Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite
) ([(Coordinates, Maybe Piece)] -> MaybePieceByCoordinates)
-> [(Coordinates, Maybe Piece)] -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece) -> [(Coordinates, Maybe Piece)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByCoordinates (Maybe Piece)
byCoordinates
instance Property.Reflectable.ReflectableOnY MaybePieceByCoordinates where
reflectOnY :: MaybePieceByCoordinates -> MaybePieceByCoordinates
reflectOnY MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ (Coordinates, Coordinates)
-> (Coordinates -> Coordinates)
-> ArrayByCoordinates (Maybe Piece)
-> ArrayByCoordinates (Maybe Piece)
forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
Data.Array.IArray.ixmap (Coordinates
forall a. Bounded a => a
minBound, Coordinates
forall a. Bounded a => a
maxBound) Coordinates -> Coordinates
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY ArrayByCoordinates (Maybe Piece)
byCoordinates
instance Property.Empty.Empty MaybePieceByCoordinates where
empty :: MaybePieceByCoordinates
empty = ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ([Maybe Piece] -> ArrayByCoordinates (Maybe Piece))
-> [Maybe Piece]
-> MaybePieceByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Piece] -> ArrayByCoordinates (Maybe Piece)
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Coordinates e
Cartesian.Coordinates.listArrayByCoordinates ([Maybe Piece] -> MaybePieceByCoordinates)
-> [Maybe Piece] -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ Maybe Piece -> [Maybe Piece]
forall a. a -> [a]
repeat Maybe Piece
forall a. Empty a => a
Property.Empty.empty
instance Control.DeepSeq.NFData MaybePieceByCoordinates where
rnf :: MaybePieceByCoordinates -> ()
rnf MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = ArrayByCoordinates (Maybe Piece) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ArrayByCoordinates (Maybe Piece)
byCoordinates
instance StateProperty.Censor.Censor MaybePieceByCoordinates where
countPiecesByLogicalColour :: MaybePieceByCoordinates -> (Int, Int)
countPiecesByLogicalColour = ((Int, Int) -> Piece -> (Int, Int))
-> (Int, Int) -> [Piece] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\(Int
nBlack, Int
nWhite) Piece
piece -> if Piece -> Bool
Component.Piece.isBlack Piece
piece
then let nBlack' :: Int
nBlack' = Int -> Int
forall a. Enum a => a -> a
succ Int
nBlack in Int
nBlack' Int -> (Int, Int) -> (Int, Int)
`seq` (Int
nBlack', Int
nWhite)
else let nWhite' :: Int
nWhite' = Int -> Int
forall a. Enum a => a -> a
succ Int
nWhite in Int
nWhite' Int -> (Int, Int) -> (Int, Int)
`seq` (Int
nBlack, Int
nWhite')
) (Int
0, Int
0) ([Piece] -> (Int, Int))
-> (MaybePieceByCoordinates -> [Piece])
-> MaybePieceByCoordinates
-> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybePieceByCoordinates -> [Piece]
getPieces
countPieces :: MaybePieceByCoordinates -> Int
countPieces = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int)
-> (MaybePieceByCoordinates -> Int)
-> MaybePieceByCoordinates
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Piece] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Piece] -> Int)
-> (MaybePieceByCoordinates -> [Piece])
-> MaybePieceByCoordinates
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybePieceByCoordinates -> [Piece]
getPieces
countPieceDifferenceByRank :: MaybePieceByCoordinates -> NPiecesByRank
countPieceDifferenceByRank = (Int -> Int -> Int)
-> Int -> (Rank, Rank) -> [(Rank, Int)] -> NPiecesByRank
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Rank
forall a. Bounded a => a
minBound, Rank
forall a. Bounded a => a
maxBound) ([(Rank, Int)] -> NPiecesByRank)
-> (MaybePieceByCoordinates -> [(Rank, Int)])
-> MaybePieceByCoordinates
-> NPiecesByRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece -> (Rank, Int)) -> [Piece] -> [(Rank, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (
Piece -> Rank
Component.Piece.getRank (Piece -> Rank) -> (Piece -> Int) -> Piece -> (Rank, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
\Piece
piece -> (
if Piece -> Bool
Component.Piece.isBlack Piece
piece
then Int -> Int
forall a. Num a => a -> a
negate
else Int -> Int
forall a. a -> a
id
) Int
1
)
) ([Piece] -> [(Rank, Int)])
-> (MaybePieceByCoordinates -> [Piece])
-> MaybePieceByCoordinates
-> [(Rank, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybePieceByCoordinates -> [Piece]
getPieces
hasInsufficientMaterial :: MaybePieceByCoordinates -> Bool
hasInsufficientMaterial MaybePieceByCoordinates
maybePieceByCoordinates = ((Coordinates, Piece) -> Bool) -> [(Coordinates, Piece)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
(Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Rank]
Attribute.Rank.individuallySufficientMaterial) (Rank -> Bool)
-> ((Coordinates, Piece) -> Rank) -> (Coordinates, Piece) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> Rank
Component.Piece.getRank (Piece -> Rank)
-> ((Coordinates, Piece) -> Piece) -> (Coordinates, Piece) -> Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates, Piece) -> Piece
forall a b. (a, b) -> b
snd
) [(Coordinates, Piece)]
locatedPieces 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
locatedPieces :: [(Coordinates, Piece)]
locatedPieces = MaybePieceByCoordinates -> [(Coordinates, Piece)]
forall seeker. Seeker seeker => seeker -> [(Coordinates, Piece)]
StateProperty.Seeker.findAllPieces MaybePieceByCoordinates
maybePieceByCoordinates
[[Coordinates]
blackKnights, [Coordinates]
blackBishops, [Coordinates]
whiteKnights, [Coordinates]
whiteBishops] = [
[
Coordinates
coordinates |
(Coordinates
coordinates, Piece
piece) <- [(Coordinates, Piece)]
locatedPieces,
Piece
piece Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank
] |
LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
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 :: MaybePieceByCoordinates -> Bool
hasBothKings MaybePieceByCoordinates
maybePieceByCoordinates = case (Piece -> Bool) -> [Piece] -> ([Piece], [Piece])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition Piece -> Bool
Component.Piece.isBlack ([Piece] -> ([Piece], [Piece]))
-> ([Piece] -> [Piece]) -> [Piece] -> ([Piece], [Piece])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece -> Bool) -> [Piece] -> [Piece]
forall a. (a -> Bool) -> [a] -> [a]
filter Piece -> Bool
Component.Piece.isKing ([Piece] -> ([Piece], [Piece])) -> [Piece] -> ([Piece], [Piece])
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates -> [Piece]
getPieces MaybePieceByCoordinates
maybePieceByCoordinates of
([Piece
_], [Piece
_]) -> Bool
True
([Piece], [Piece])
_ -> Bool
False
instance StateProperty.Hashable.Hashable MaybePieceByCoordinates where
listRandoms :: Zobrist positionHash -> MaybePieceByCoordinates -> [positionHash]
listRandoms Zobrist positionHash
zobrist MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = [
Zobrist positionHash -> Index -> positionHash
forall positionHash. Zobrist positionHash -> Index -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour Zobrist positionHash
zobrist (Index -> positionHash) -> Index -> positionHash
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> Rank -> Coordinates -> Index)
-> (LogicalColour, Rank) -> Coordinates -> Index
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,,) (Piece -> LogicalColour
Component.Piece.getLogicalColour (Piece -> LogicalColour)
-> (Piece -> Rank) -> Piece -> (LogicalColour, Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Piece -> Rank
Component.Piece.getRank (Piece -> (LogicalColour, Rank)) -> Piece -> (LogicalColour, Rank)
forall a b. (a -> b) -> a -> b
$ Piece
piece) Coordinates
coordinates |
(Coordinates
coordinates, Just Piece
piece) <- ArrayByCoordinates (Maybe Piece) -> [(Coordinates, Maybe Piece)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByCoordinates (Maybe Piece)
byCoordinates
]
instance StateProperty.Mutator.Mutator MaybePieceByCoordinates where
defineCoordinates :: Maybe Piece
-> Coordinates
-> MaybePieceByCoordinates
-> MaybePieceByCoordinates
defineCoordinates Maybe Piece
maybePiece Coordinates
coordinates MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = Bool -> MaybePieceByCoordinates -> MaybePieceByCoordinates
forall a. Partial => Bool -> a -> a
Control.Exception.assert (
Maybe Piece -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe Piece
maybePiece Bool -> Bool -> Bool
|| Maybe Piece -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust (ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
coordinates)
) (MaybePieceByCoordinates -> MaybePieceByCoordinates)
-> (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ArrayByCoordinates (Maybe Piece)
-> MaybePieceByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece)
-> [(Coordinates, Maybe Piece)] -> ArrayByCoordinates (Maybe Piece)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(Coordinates
coordinates, Maybe Piece
maybePiece)]
movePiece :: Move
-> MoveType
-> Piece
-> MaybePieceByCoordinates
-> MaybePieceByCoordinates
movePiece Move
move MoveType
moveType Piece
sourcePiece MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece)
-> [(Coordinates, Maybe Piece)] -> ArrayByCoordinates (Maybe Piece)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// (
if MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType
then (:) (
LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.retreat (Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece) (Coordinates -> Coordinates) -> Coordinates -> Coordinates
forall a b. (a -> b) -> a -> b
$ Move -> Coordinates
Component.Move.getDestination Move
move,
Maybe Piece
forall a. Maybe a
Nothing
)
else [(Coordinates, Maybe Piece)] -> [(Coordinates, Maybe Piece)]
forall a. a -> a
id
) [
(
Move -> Coordinates
Component.Move.getSource Move
move,
Maybe Piece
forall a. Maybe a
Nothing
), (
Move -> Coordinates
Component.Move.getDestination Move
move,
Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Piece -> Maybe Piece) -> Piece -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ (Piece -> Piece)
-> (Rank -> Piece -> Piece) -> Maybe Rank -> Piece -> Piece
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Piece -> Piece
forall a. a -> a
id Rank -> Piece -> Piece
Component.Piece.promote (MoveType -> Maybe Rank
Attribute.MoveType.getMaybePromotedRank MoveType
moveType) Piece
sourcePiece
)
]
instance StateProperty.Seeker.Seeker MaybePieceByCoordinates where
findProximateKnights :: MaybePieceByCoordinates
-> LogicalColour -> Coordinates -> [Coordinates]
findProximateKnights MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } LogicalColour
logicalColour Coordinates
destination = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates]
forall a. (a -> Bool) -> [a] -> [a]
filter (
(Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
knight) (Maybe Piece -> Bool)
-> (Coordinates -> Maybe Piece) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ Piece -> Coordinates -> [Coordinates]
Component.Piece.findAttackDestinations Piece
knight Coordinates
destination where
knight :: Piece
knight = LogicalColour -> Piece
Component.Piece.mkKnight LogicalColour
logicalColour
findPieces :: (Piece -> Bool)
-> MaybePieceByCoordinates -> [(Coordinates, Piece)]
findPieces Piece -> Bool
predicate MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = [
(Coordinates
coordinates, Piece
piece) |
(Coordinates
coordinates, Just Piece
piece) <- ArrayByCoordinates (Maybe Piece) -> [(Coordinates, Maybe Piece)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByCoordinates (Maybe Piece)
byCoordinates,
Piece -> Bool
predicate Piece
piece
]
instance StateProperty.View.View MaybePieceByCoordinates where
fromAssocs :: [(Coordinates, Piece)] -> MaybePieceByCoordinates
fromAssocs = ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates
MkMaybePieceByCoordinates (ArrayByCoordinates (Maybe Piece) -> MaybePieceByCoordinates)
-> ([(Coordinates, Piece)] -> ArrayByCoordinates (Maybe Piece))
-> [(Coordinates, Piece)]
-> MaybePieceByCoordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Piece -> Maybe Piece -> Maybe Piece)
-> Maybe Piece
-> (Coordinates, Coordinates)
-> [(Coordinates, Maybe Piece)]
-> ArrayByCoordinates (Maybe Piece)
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 ((Maybe Piece -> Maybe Piece -> Maybe Piece)
-> Maybe Piece -> Maybe Piece -> Maybe Piece
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe Piece -> Maybe Piece -> Maybe Piece
forall a b. a -> b -> a
const) Maybe Piece
forall a. Maybe a
Nothing (Coordinates
forall a. Bounded a => a
minBound, Coordinates
forall a. Bounded a => a
maxBound) ([(Coordinates, Maybe Piece)] -> ArrayByCoordinates (Maybe Piece))
-> ([(Coordinates, Piece)] -> [(Coordinates, Maybe Piece)])
-> [(Coordinates, Piece)]
-> ArrayByCoordinates (Maybe Piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates, Piece) -> (Coordinates, Maybe Piece))
-> [(Coordinates, Piece)] -> [(Coordinates, Maybe Piece)]
forall a b. (a -> b) -> [a] -> [b]
map ((Piece -> Maybe Piece)
-> (Coordinates, Piece) -> (Coordinates, Maybe Piece)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second Piece -> Maybe Piece
forall a. a -> Maybe a
Just)
instance Component.Accountant.Accountant MaybePieceByCoordinates where
sumPieceSquareValueByLogicalColour :: PieceSquareValueByCoordinatesByRank
-> MaybePieceByCoordinates -> Int -> [Base]
sumPieceSquareValueByLogicalColour PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank MaybePieceByCoordinates
maybePieceByCoordinates Int
nPieces = (
\(Base
b, Base
w) -> [Base
b, Base
w]
) ((Base, Base) -> [Base])
-> ([(Coordinates, Piece)] -> (Base, Base))
-> [(Coordinates, Piece)]
-> [Base]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Base, Base) -> (Coordinates, Piece) -> (Base, Base))
-> (Base, Base) -> [(Coordinates, Piece)] -> (Base, Base)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\(Base
b, Base
w) (Coordinates
coordinates, Piece
piece) -> let
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece
pieceSquareValue :: Base
pieceSquareValue = 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 (Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates (Rank -> PieceSquareValueByCoordinates)
-> Rank -> PieceSquareValueByCoordinates
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
piece) LogicalColour
logicalColour Coordinates
coordinates
in if LogicalColour -> Bool
Colour.LogicalColour.isBlack LogicalColour
logicalColour
then let b' :: Base
b' = Base
b Base -> Base -> Base
forall a. Num a => a -> a -> a
+ Base
pieceSquareValue in Base
b' Base -> (Base, Base) -> (Base, Base)
`seq` (Base
b', Base
w)
else let w' :: Base
w' = Base
w Base -> Base -> Base
forall a. Num a => a -> a -> a
+ Base
pieceSquareValue in Base
w' Base -> (Base, Base) -> (Base, Base)
`seq` (Base
b, Base
w')
) (Base
0, Base
0) ([(Coordinates, Piece)] -> [Base])
-> [(Coordinates, Piece)] -> [Base]
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates -> [(Coordinates, Piece)]
forall seeker. Seeker seeker => seeker -> [(Coordinates, Piece)]
StateProperty.Seeker.findAllPieces MaybePieceByCoordinates
maybePieceByCoordinates where
getPieceSquareValueByCoordinates :: Rank -> PieceSquareValueByCoordinates
getPieceSquareValueByCoordinates = PieceSquareValueByCoordinatesByRank
-> Int -> Rank -> PieceSquareValueByCoordinates
Component.PieceSquareValueByCoordinatesByRank.getPieceSquareValueByCoordinates PieceSquareValueByCoordinatesByRank
pieceSquareValueByCoordinatesByRank Int
nPieces
instance Property.SelfValidating.SelfValidating MaybePieceByCoordinates where
findInvalidity :: MaybePieceByCoordinates -> [String]
findInvalidity = ([String] -> [String] -> [String])
-> ([String], [String]) -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) (([String], [String]) -> [String])
-> (MaybePieceByCoordinates -> ([String], [String]))
-> MaybePieceByCoordinates
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybePieceByCoordinates -> [String]
forall censor. Censor censor => censor -> [String]
StateProperty.Censor.findInvalidity (MaybePieceByCoordinates -> [String])
-> (MaybePieceByCoordinates -> [String])
-> MaybePieceByCoordinates
-> ([String], [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& MaybePieceByCoordinates -> [String]
forall seeker. Seeker seeker => seeker -> [String]
StateProperty.Seeker.findInvalidity)
dereference :: MaybePieceByCoordinates -> Cartesian.Coordinates.Coordinates -> Maybe Component.Piece.Piece
{-# INLINE dereference #-}
dereference :: MaybePieceByCoordinates -> Coordinates -> Maybe Piece
dereference MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = (ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
inferMoveType
:: MaybePieceByCoordinates
-> Component.Move.Move
-> Maybe Attribute.Rank.Rank
-> Attribute.MoveType.MoveType
inferMoveType :: MaybePieceByCoordinates -> Move -> Maybe Rank -> MoveType
inferMoveType maybePieceByCoordinates :: MaybePieceByCoordinates
maybePieceByCoordinates@MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Move
move Maybe Rank
maybePromotionRank
| Just Piece
sourcePiece <- ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Move -> Coordinates
Component.Move.getSource Move
move = MoveType
-> (CastlingMove -> MoveType) -> Maybe CastlingMove -> MoveType
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
if MaybePieceByCoordinates -> Move -> Bool
isEnPassantMove MaybePieceByCoordinates
maybePieceByCoordinates Move
move
then MoveType
Attribute.MoveType.enPassant
else let
destination :: Coordinates
destination = Move -> Coordinates
Component.Move.getDestination Move
move
in Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType (
Piece -> Rank
Component.Piece.getRank (Piece -> Rank) -> Maybe Piece -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
destination
) (Maybe Rank -> MoveType) -> Maybe Rank -> MoveType
forall a b. (a -> b) -> a -> b
$ if Piece -> Coordinates -> Bool
Component.Piece.isPawnPromotion Piece
sourcePiece Coordinates
destination
then Maybe Rank
maybePromotionRank Maybe Rank -> Maybe Rank -> Maybe Rank
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.defaultPromotionRank
else Maybe Rank
forall a. Maybe a
Nothing
) CastlingMove -> MoveType
Component.CastlingMove.getMoveType (Maybe CastlingMove -> MoveType) -> Maybe CastlingMove -> MoveType
forall a b. (a -> b) -> a -> b
$ if Piece -> Bool
Component.Piece.isKing Piece
sourcePiece
then (CastlingMove -> Bool) -> [CastlingMove] -> Maybe CastlingMove
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
(Move -> Move -> Bool
forall a. Eq a => a -> a -> Bool
== Move
move) (Move -> Bool) -> (CastlingMove -> Move) -> CastlingMove -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove -> Move
Component.CastlingMove.getKingsMove
) ([CastlingMove] -> Maybe CastlingMove)
-> (LogicalColour -> [CastlingMove])
-> LogicalColour
-> Maybe CastlingMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> [CastlingMove]
Component.CastlingMove.getCastlingMoves (LogicalColour -> Maybe CastlingMove)
-> LogicalColour -> Maybe CastlingMove
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece
else Maybe CastlingMove
forall a. Maybe a
Nothing
| Bool
otherwise = Exception -> MoveType
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> MoveType)
-> (String -> Exception) -> String -> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.MaybePieceByCoordinates.inferMoveType:\tno piece exists at " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> ShowS
forall a. Show a => a -> ShowS
shows (Move -> Coordinates
Component.Move.getSource Move
move) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> MoveType) -> String -> MoveType
forall a b. (a -> b) -> a -> b
$ MaybePieceByCoordinates -> ShowS
forall a. Show a => a -> ShowS
shows MaybePieceByCoordinates
maybePieceByCoordinates String
"."
listDestinationsFor
:: MaybePieceByCoordinates
-> Cartesian.Coordinates.Coordinates
-> Component.Piece.Piece
-> [(Cartesian.Coordinates.Coordinates, Maybe Attribute.Rank.Rank)]
listDestinationsFor :: MaybePieceByCoordinates
-> Coordinates -> Piece -> [(Coordinates, Maybe Rank)]
listDestinationsFor maybePieceByCoordinates :: MaybePieceByCoordinates
maybePieceByCoordinates@MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Coordinates
source Piece
piece = Bool -> [(Coordinates, Maybe Rank)] -> [(Coordinates, Maybe Rank)]
forall a. Partial => Bool -> a -> a
Control.Exception.assert (
ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
source Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
piece
) ([(Coordinates, Maybe Rank)] -> [(Coordinates, Maybe Rank)])
-> [(Coordinates, Maybe Rank)] -> [(Coordinates, Maybe Rank)]
forall a b. (a -> b) -> a -> b
$ if Piece -> Rank
Component.Piece.getRank Piece
piece Rank -> [Rank] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Rank]
Attribute.Rank.fixedAttackRange
then let
findAttackDestinations :: (Maybe Component.Piece.Piece -> Bool) -> [(Cartesian.Coordinates.Coordinates, Maybe Attribute.Rank.Rank)]
findAttackDestinations :: (Maybe Piece -> Bool) -> [(Coordinates, Maybe Rank)]
findAttackDestinations Maybe Piece -> Bool
predicate = [
(Coordinates
destination, Piece -> Rank
Component.Piece.getRank (Piece -> Rank) -> Maybe Piece -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Piece
maybeDestinationPiece) |
Coordinates
destination <- Piece -> Coordinates -> [Coordinates]
Component.Piece.findAttackDestinations Piece
piece Coordinates
source,
let maybeDestinationPiece :: Maybe Piece
maybeDestinationPiece = ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
destination,
Maybe Piece -> Bool
predicate Maybe Piece
maybeDestinationPiece
]
in if Piece -> Bool
Component.Piece.isPawn Piece
piece
then (Maybe Piece -> Bool) -> [(Coordinates, Maybe Rank)]
findAttackDestinations (
Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False ((Piece -> Bool) -> Maybe Piece -> Bool)
-> (Piece -> Bool) -> Maybe Piece -> Bool
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour) (LogicalColour -> Bool)
-> (Piece -> LogicalColour) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour
) [(Coordinates, Maybe Rank)]
-> [(Coordinates, Maybe Rank)] -> [(Coordinates, Maybe Rank)]
forall a. [a] -> [a] -> [a]
++ let
advance :: Cartesian.Coordinates.Coordinates -> Cartesian.Coordinates.Coordinates
advance :: Coordinates -> Coordinates
advance = LogicalColour -> Coordinates -> Coordinates
Cartesian.Coordinates.advance LogicalColour
logicalColour
advancedLocation :: Coordinates
advancedLocation = Coordinates -> Coordinates
advance Coordinates
source
in if MaybePieceByCoordinates -> Coordinates -> Bool
isVacant MaybePieceByCoordinates
maybePieceByCoordinates Coordinates
advancedLocation
then (Coordinates -> (Coordinates, Maybe Rank))
-> [Coordinates] -> [(Coordinates, Maybe Rank)]
forall a b. (a -> b) -> [a] -> [b]
map (
(Coordinates -> Maybe Rank -> (Coordinates, Maybe Rank))
-> Maybe Rank -> Coordinates -> (Coordinates, Maybe Rank)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Maybe Rank
forall a. Maybe a
Nothing
) ([Coordinates] -> [(Coordinates, Maybe Rank)])
-> [Coordinates] -> [(Coordinates, Maybe Rank)]
forall a b. (a -> b) -> a -> b
$ Coordinates
advancedLocation Coordinates -> [Coordinates] -> [Coordinates]
forall a. a -> [a] -> [a]
: [
Coordinates
doubleAdvancedLocation |
Coordinates -> LogicalColour -> Bool
Cartesian.Coordinates.isPawnsFirstRank Coordinates
source LogicalColour
logicalColour,
let doubleAdvancedLocation :: Coordinates
doubleAdvancedLocation = Coordinates -> Coordinates
advance Coordinates
advancedLocation,
MaybePieceByCoordinates -> Coordinates -> Bool
isVacant MaybePieceByCoordinates
maybePieceByCoordinates Coordinates
doubleAdvancedLocation
]
else []
else (Maybe Piece -> Bool) -> [(Coordinates, Maybe Rank)]
findAttackDestinations ((Maybe Piece -> Bool) -> [(Coordinates, Maybe Rank)])
-> ((Piece -> Bool) -> Maybe Piece -> Bool)
-> (Piece -> Bool)
-> [(Coordinates, Maybe Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True ((Piece -> Bool) -> [(Coordinates, Maybe Rank)])
-> (Piece -> Bool) -> [(Coordinates, Maybe Rank)]
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour) (LogicalColour -> Bool)
-> (Piece -> LogicalColour) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour
else let
takeUntil :: Cartesian.Coordinates.QualifiedStraightLine -> [(Cartesian.Coordinates.Coordinates, Maybe Attribute.Rank.Rank)]
#ifdef USE_ARRAY_UNSAFEAT
takeUntil :: QualifiedStraightLine -> [(Coordinates, Maybe Rank)]
takeUntil ((Coordinates
destination, Int
ix) : QualifiedStraightLine
remainder)
| Just Piece
blockingPiece <- ArrayByCoordinates (Maybe Piece) -> Int -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
Data.Array.Base.unsafeAt ArrayByCoordinates (Maybe Piece)
byCoordinates Int
ix
#else
takeUntil ((destination, _) : remainder)
| Just blockingPiece <- byCoordinates ! destination
#endif
= [
(
Coordinates
destination,
Rank -> Maybe Rank
forall a. a -> Maybe a
Just (Rank -> Maybe Rank) -> Rank -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
blockingPiece
) | Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
blockingPiece LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour
]
| Bool
otherwise = (Coordinates
destination, Maybe Rank
forall a. Maybe a
Nothing) (Coordinates, Maybe Rank)
-> [(Coordinates, Maybe Rank)] -> [(Coordinates, Maybe Rank)]
forall a. a -> [a] -> [a]
: QualifiedStraightLine -> [(Coordinates, Maybe Rank)]
takeUntil QualifiedStraightLine
remainder
takeUntil QualifiedStraightLine
_ = []
in (QualifiedStraightLine -> [(Coordinates, Maybe Rank)])
-> Coordinates -> Maybe [Direction] -> [(Coordinates, Maybe Rank)]
forall a.
(QualifiedStraightLine -> [a])
-> Coordinates -> Maybe [Direction] -> [a]
Cartesian.Coordinates.applyAlongDirectionsFrom QualifiedStraightLine -> [(Coordinates, Maybe Rank)]
takeUntil Coordinates
source (Maybe [Direction] -> [(Coordinates, Maybe Rank)])
-> Maybe [Direction] -> [(Coordinates, Maybe Rank)]
forall a b. (a -> b) -> a -> b
$ if Piece -> Bool
Component.Piece.isQueen Piece
piece
then Maybe [Direction]
forall a. Maybe a
Nothing
else [Direction] -> Maybe [Direction]
forall a. a -> Maybe a
Just ([Direction] -> Maybe [Direction])
-> [Direction] -> Maybe [Direction]
forall a b. (a -> b) -> a -> b
$ Piece -> [Direction]
Component.Piece.getAttackDirections Piece
piece
where
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece
shows2D
:: MaybePieceByCoordinates
-> Type.Length.Column
-> Colour.ColourScheme.ColourScheme
-> Bool
-> (Type.Length.X, Type.Length.Y)
-> ShowS
shows2D :: MaybePieceByCoordinates
-> Int -> ColourScheme -> Bool -> (Int, Int) -> ShowS
shows2D MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Int
boardColumnMagnification ColourScheme
colourScheme Bool
depictFigurine (Int
xOrigin, Int
yOrigin) = (
((Char, [(Coordinates, Char)]) -> ShowS -> ShowS)
-> ShowS -> [(Char, [(Coordinates, Char)])] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\(Char
y, [(Coordinates, Char)]
pairs) ShowS
showsRow -> ShowS
showsRow ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
axisGraphicsRendition ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates, Char) -> ShowS -> ShowS)
-> ShowS -> [(Coordinates, Char)] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\(Coordinates
coordinates, Char
c) ShowS
acc' -> String -> ShowS
showString (
Bool -> ANSIColourCode -> String
Colour.ANSIColourCode.selectGraphicsRendition Bool
False (ANSIColourCode -> String)
-> (PhysicalColour -> ANSIColourCode) -> PhysicalColour -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalColour -> ANSIColourCode
Colour.ANSIColourCode.mkBgColourCode (PhysicalColour -> String) -> PhysicalColour -> String
forall a b. (a -> b) -> a -> b
$ (
if LogicalColourOfSquare -> Bool
Colour.LogicalColourOfSquare.isBlack (LogicalColourOfSquare -> Bool) -> LogicalColourOfSquare -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> LogicalColourOfSquare
Cartesian.Coordinates.getLogicalColourOfSquare Coordinates
coordinates
then ColourScheme -> PhysicalColour
Colour.ColourScheme.getDarkSquareColour
else ColourScheme -> PhysicalColour
Colour.ColourScheme.getLightSquareColour
) ColourScheme
colourScheme
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (
Bool -> ANSIColourCode -> String
Colour.ANSIColourCode.selectGraphicsRendition Bool
True (ANSIColourCode -> String)
-> (PhysicalColour -> ANSIColourCode) -> PhysicalColour -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalColour -> ANSIColourCode
Colour.ANSIColourCode.mkFgColourCode (PhysicalColour -> String) -> PhysicalColour -> String
forall a b. (a -> b) -> a -> b
$ (
if Char -> Bool
Data.Char.isLower Char
c
then ColourScheme -> PhysicalColour
Colour.ColourScheme.getDarkPieceColour
else ColourScheme -> PhysicalColour
Colour.ColourScheme.getLightPieceColour
) ColourScheme
colourScheme
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. let
showPadding :: ShowS
showPadding = String -> ShowS
showString (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Enum a => a -> a
pred Int
boardColumnMagnification) Int -> Char -> String
forall a. Int -> a -> [a]
`replicate` Char
' ')
in ShowS
showPadding ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showPadding ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
acc'
) ShowS
showsReset [(Coordinates, Char)]
pairs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n'
) ShowS
forall a. a -> a
id ([(Char, [(Coordinates, Char)])] -> ShowS)
-> ([(Coordinates, Maybe Piece)]
-> [(Char, [(Coordinates, Char)])])
-> [(Coordinates, Maybe Piece)]
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [[(Coordinates, Char)]] -> [(Char, [(Coordinates, Char)])]
forall a b. [a] -> [b] -> [(a, b)]
zip (
Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Ordinate.yLength) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. Enum a => a -> [a]
enumFrom (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Data.Char.chr (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yOrigin
) ([[(Coordinates, Char)]] -> [(Char, [(Coordinates, Char)])])
-> ([(Coordinates, Maybe Piece)] -> [[(Coordinates, Char)]])
-> [(Coordinates, Maybe Piece)]
-> [(Char, [(Coordinates, Char)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates, Char)] -> [[(Coordinates, Char)]]
forall a. [a] -> [[a]]
listToRaster ([(Coordinates, Char)] -> [[(Coordinates, Char)]])
-> ([(Coordinates, Maybe Piece)] -> [(Coordinates, Char)])
-> [(Coordinates, Maybe Piece)]
-> [[(Coordinates, Char)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates, Maybe Piece) -> (Coordinates, Char))
-> [(Coordinates, Maybe Piece)] -> [(Coordinates, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (
(Maybe Piece -> Char)
-> (Coordinates, Maybe Piece) -> (Coordinates, Char)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second ((Maybe Piece -> Char)
-> (Coordinates, Maybe Piece) -> (Coordinates, Char))
-> ((Piece -> Char) -> Maybe Piece -> Char)
-> (Piece -> Char)
-> (Coordinates, Maybe Piece)
-> (Coordinates, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> (Piece -> Char) -> Maybe Piece -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Char
' ' ((Piece -> Char)
-> (Coordinates, Maybe Piece) -> (Coordinates, Char))
-> (Piece -> Char)
-> (Coordinates, Maybe Piece)
-> (Coordinates, Char)
forall a b. (a -> b) -> a -> b
$ if Bool
depictFigurine
then Piece -> Char
Notation.Figurine.toFigurine
else String -> Char
forall a. [a] -> a
head (String -> Char) -> (Piece -> String) -> Piece -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> String
forall a. Show a => a -> String
show
) ([(Coordinates, Maybe Piece)] -> ShowS)
-> [(Coordinates, Maybe Piece)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece) -> [(Coordinates, Maybe Piece)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Data.Array.IArray.assocs ArrayByCoordinates (Maybe Piece)
byCoordinates
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (
Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
boardColumnMagnification) Char
' '
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
axisGraphicsRendition ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
showsReset (
ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
Data.List.intersperse (
String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Enum a => a -> a
pred Int
boardColumnMagnification)) Char
' '
) ([ShowS] -> [ShowS]) -> (Int -> [ShowS]) -> Int -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS) -> String -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ShowS
showChar (String -> [ShowS]) -> (Int -> String) -> Int -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take (
Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength
) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. Enum a => a -> [a]
enumFrom (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Data.Char.chr (Int -> [ShowS]) -> Int -> [ShowS]
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xOrigin
) where
axisGraphicsRendition :: Colour.ANSIColourCode.GraphicsRendition
axisGraphicsRendition :: String
axisGraphicsRendition = Bool -> ANSIColourCode -> String
Colour.ANSIColourCode.selectGraphicsRendition Bool
True (ANSIColourCode -> String) -> ANSIColourCode -> String
forall a b. (a -> b) -> a -> b
$ PhysicalColour -> ANSIColourCode
Colour.ANSIColourCode.mkFgColourCode PhysicalColour
Colour.PhysicalColour.green
showsReset :: ShowS
showsReset :: ShowS
showsReset = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ANSIColourCode -> String
Colour.ANSIColourCode.selectGraphicsRendition Bool
False ANSIColourCode
forall a. Default a => a
Data.Default.def
show2D
:: MaybePieceByCoordinates
-> Type.Length.Column
-> Colour.ColourScheme.ColourScheme
-> Bool
-> (Type.Length.X, Type.Length.Y)
-> String
show2D :: MaybePieceByCoordinates
-> Int -> ColourScheme -> Bool -> (Int, Int) -> String
show2D MaybePieceByCoordinates
maybePieceByCoordinates Int
boardColumnMagnification ColourScheme
colourScheme Bool
depictFigurine (Int
xOrigin, Int
yOrigin) = MaybePieceByCoordinates
-> Int -> ColourScheme -> Bool -> (Int, Int) -> ShowS
shows2D MaybePieceByCoordinates
maybePieceByCoordinates Int
boardColumnMagnification ColourScheme
colourScheme Bool
depictFigurine (Int
xOrigin, Int
yOrigin) String
""
getPieces :: MaybePieceByCoordinates -> [Component.Piece.Piece]
getPieces :: MaybePieceByCoordinates -> [Piece]
getPieces MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = [Maybe Piece] -> [Piece]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes ([Maybe Piece] -> [Piece]) -> [Maybe Piece] -> [Piece]
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece) -> [Maybe Piece]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList ArrayByCoordinates (Maybe Piece)
byCoordinates
findBlockingPiece
:: MaybePieceByCoordinates
-> Cartesian.Coordinates.Coordinates
-> Direction.Direction.Direction
-> Maybe Component.Piece.LocatedPiece
findBlockingPiece :: MaybePieceByCoordinates
-> Coordinates -> Direction -> Maybe (Coordinates, Piece)
findBlockingPiece MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Coordinates
source = QualifiedStraightLine -> Maybe (Coordinates, Piece)
slave (QualifiedStraightLine -> Maybe (Coordinates, Piece))
-> (Direction -> QualifiedStraightLine)
-> Direction
-> Maybe (Coordinates, Piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Direction -> QualifiedStraightLine
Cartesian.Coordinates.extrapolate Coordinates
source where
slave :: Cartesian.Coordinates.QualifiedStraightLine -> Maybe Component.Piece.LocatedPiece
#ifdef USE_ARRAY_UNSAFEAT
slave :: QualifiedStraightLine -> Maybe (Coordinates, Piece)
slave ((Coordinates
coordinates, Int
ix) : QualifiedStraightLine
remainder)
| Just Piece
blockingPiece <- ArrayByCoordinates (Maybe Piece) -> Int -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
Data.Array.Base.unsafeAt ArrayByCoordinates (Maybe Piece)
byCoordinates Int
ix
#else
slave ((coordinates, _) : remainder)
| Just blockingPiece <- byCoordinates ! coordinates
#endif
= (Coordinates, Piece) -> Maybe (Coordinates, Piece)
forall a. a -> Maybe a
Just (Coordinates
coordinates, Piece
blockingPiece)
| Bool
otherwise = QualifiedStraightLine -> Maybe (Coordinates, Piece)
slave QualifiedStraightLine
remainder
slave QualifiedStraightLine
_ = Maybe (Coordinates, Piece)
forall a. Maybe a
Nothing
findBlockingPieces
:: MaybePieceByCoordinates
-> Cartesian.Coordinates.Coordinates
-> Maybe [Direction.Direction.Direction]
-> [Component.Piece.LocatedPiece]
findBlockingPieces :: MaybePieceByCoordinates
-> Coordinates -> Maybe [Direction] -> [(Coordinates, Piece)]
findBlockingPieces MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } = (QualifiedStraightLine -> [(Coordinates, Piece)])
-> Coordinates -> Maybe [Direction] -> [(Coordinates, Piece)]
forall a.
(QualifiedStraightLine -> [a])
-> Coordinates -> Maybe [Direction] -> [a]
Cartesian.Coordinates.applyAlongDirectionsFrom QualifiedStraightLine -> [(Coordinates, Piece)]
slave where
slave :: Cartesian.Coordinates.QualifiedStraightLine -> [Component.Piece.LocatedPiece]
#ifdef USE_ARRAY_UNSAFEAT
slave :: QualifiedStraightLine -> [(Coordinates, Piece)]
slave ((Coordinates
coordinates, Int
ix) : QualifiedStraightLine
remainder)
| Just Piece
blockingPiece <- ArrayByCoordinates (Maybe Piece) -> Int -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
Data.Array.Base.unsafeAt ArrayByCoordinates (Maybe Piece)
byCoordinates Int
ix
#else
slave ((coordinates, _) : remainder)
| Just blockingPiece <- byCoordinates ! coordinates
#endif
= [(Coordinates
coordinates, Piece
blockingPiece)]
| Bool
otherwise = QualifiedStraightLine -> [(Coordinates, Piece)]
slave QualifiedStraightLine
remainder
slave QualifiedStraightLine
_ = []
findAttackerInDirection
:: MaybePieceByCoordinates
-> Colour.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates
-> Direction.Direction.Direction
-> Maybe (Cartesian.Coordinates.Coordinates, Attribute.Rank.Rank)
findAttackerInDirection :: MaybePieceByCoordinates
-> LogicalColour
-> Coordinates
-> Direction
-> Maybe (Coordinates, Rank)
findAttackerInDirection MaybePieceByCoordinates
maybePieceByCoordinates LogicalColour
destinationLogicalColour Coordinates
destination Direction
direction = MaybePieceByCoordinates
-> Coordinates -> Direction -> Maybe (Coordinates, Piece)
findBlockingPiece MaybePieceByCoordinates
maybePieceByCoordinates Coordinates
destination Direction
direction Maybe (Coordinates, Piece)
-> ((Coordinates, Piece) -> Maybe (Coordinates, Rank))
-> Maybe (Coordinates, Rank)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Coordinates
source, Piece
sourcePiece) -> if Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
destinationLogicalColour Bool -> Bool -> Bool
&& Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
source Coordinates
destination Piece
sourcePiece
then (Coordinates, Rank) -> Maybe (Coordinates, Rank)
forall a. a -> Maybe a
Just (Coordinates
source, Piece -> Rank
Component.Piece.getRank Piece
sourcePiece)
else Maybe (Coordinates, Rank)
forall a. Maybe a
Nothing
findAttackerInDirections
:: MaybePieceByCoordinates
-> Colour.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates
-> Maybe [Direction.Direction.Direction]
-> [(Cartesian.Coordinates.Coordinates, Attribute.Rank.Rank)]
findAttackerInDirections :: MaybePieceByCoordinates
-> LogicalColour
-> Coordinates
-> Maybe [Direction]
-> [(Coordinates, Rank)]
findAttackerInDirections MaybePieceByCoordinates
maybePieceByCoordinates LogicalColour
destinationLogicalColour Coordinates
destination = ((Coordinates, Piece) -> Maybe (Coordinates, Rank))
-> [(Coordinates, Piece)] -> [(Coordinates, Rank)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (
\(Coordinates
source, Piece
sourcePiece) -> if Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
destinationLogicalColour Bool -> Bool -> Bool
&& Coordinates -> Coordinates -> Piece -> Bool
Component.Piece.canAttackAlong Coordinates
source Coordinates
destination Piece
sourcePiece
then (Coordinates, Rank) -> Maybe (Coordinates, Rank)
forall a. a -> Maybe a
Just (Coordinates
source, Piece -> Rank
Component.Piece.getRank Piece
sourcePiece)
else Maybe (Coordinates, Rank)
forall a. Maybe a
Nothing
) ([(Coordinates, Piece)] -> [(Coordinates, Rank)])
-> (Maybe [Direction] -> [(Coordinates, Piece)])
-> Maybe [Direction]
-> [(Coordinates, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybePieceByCoordinates
-> Coordinates -> Maybe [Direction] -> [(Coordinates, Piece)]
findBlockingPieces MaybePieceByCoordinates
maybePieceByCoordinates Coordinates
destination
isVacant :: MaybePieceByCoordinates -> Cartesian.Coordinates.Coordinates -> Bool
{-# INLINE isVacant #-}
isVacant :: MaybePieceByCoordinates -> Coordinates -> Bool
isVacant MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Coordinates
coordinates
| Maybe Piece
Nothing <- ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
coordinates = Bool
True
| Bool
otherwise = Bool
False
isOccupied :: MaybePieceByCoordinates -> Cartesian.Coordinates.Coordinates -> Bool
isOccupied :: MaybePieceByCoordinates -> Coordinates -> Bool
isOccupied MaybePieceByCoordinates
maybePieceByCoordinates = Bool -> Bool
not (Bool -> Bool) -> (Coordinates -> Bool) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybePieceByCoordinates -> Coordinates -> Bool
isVacant MaybePieceByCoordinates
maybePieceByCoordinates
isClear
:: MaybePieceByCoordinates
-> Cartesian.Coordinates.Coordinates
-> Cartesian.Coordinates.Coordinates
-> Bool
isClear :: MaybePieceByCoordinates -> Coordinates -> Coordinates -> Bool
isClear
#ifdef USE_ARRAY_UNSAFEAT
MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Coordinates
source Coordinates
destination = ((Coordinates, Int) -> Bool) -> QualifiedStraightLine -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
Maybe Piece -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe Piece -> Bool)
-> ((Coordinates, Int) -> Maybe Piece)
-> (Coordinates, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayByCoordinates (Maybe Piece) -> Int -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
Data.Array.Base.unsafeAt ArrayByCoordinates (Maybe Piece)
byCoordinates (Int -> Maybe Piece)
-> ((Coordinates, Int) -> Int) -> (Coordinates, Int) -> Maybe Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates, Int) -> Int
forall a b. (a, b) -> b
snd
)
#else
maybePieceByCoordinates source destination = Control.Exception.assert (
source /= destination && Property.Orientated.isStraight (Component.Move.mkMove source destination)
) . all (
isVacant maybePieceByCoordinates . fst
)
#endif
(QualifiedStraightLine -> Bool)
-> (QualifiedStraightLine -> QualifiedStraightLine)
-> QualifiedStraightLine
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedStraightLine -> QualifiedStraightLine
forall a. [a] -> [a]
init (QualifiedStraightLine -> Bool) -> QualifiedStraightLine -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> Coordinates -> QualifiedStraightLine
Cartesian.Coordinates.interpolate Coordinates
source Coordinates
destination
isObstructed
:: MaybePieceByCoordinates
-> Cartesian.Coordinates.Coordinates
-> Cartesian.Coordinates.Coordinates
-> Bool
isObstructed :: MaybePieceByCoordinates -> Coordinates -> Coordinates -> Bool
isObstructed MaybePieceByCoordinates
maybePieceByCoordinates Coordinates
source = Bool -> Bool
not (Bool -> Bool) -> (Coordinates -> Bool) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybePieceByCoordinates -> Coordinates -> Coordinates -> Bool
isClear MaybePieceByCoordinates
maybePieceByCoordinates Coordinates
source
isEnPassantMove :: MaybePieceByCoordinates -> Component.Move.Move -> Bool
isEnPassantMove :: MaybePieceByCoordinates -> Move -> Bool
isEnPassantMove maybePieceByCoordinates :: MaybePieceByCoordinates
maybePieceByCoordinates@MkMaybePieceByCoordinates { deconstruct :: MaybePieceByCoordinates -> ArrayByCoordinates (Maybe Piece)
deconstruct = ArrayByCoordinates (Maybe Piece)
byCoordinates } Move
move = Bool -> (Piece -> Bool) -> Maybe Piece -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
\Piece
piece -> (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) (
Coordinates -> LogicalColour -> Bool
Cartesian.Coordinates.isEnPassantRank Coordinates
source (LogicalColour -> Bool)
-> (Piece -> LogicalColour) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Piece -> Bool
Component.Piece.isPawn (Piece -> (Bool, Bool)) -> Piece -> (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ Piece
piece
) Bool -> Bool -> Bool
&& (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) (
(Coordinates -> [Coordinates] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Piece -> Coordinates -> [Coordinates]
Component.Piece.findAttackDestinations Piece
piece Coordinates
source) (Coordinates -> Bool)
-> (Coordinates -> Bool) -> Coordinates -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& MaybePieceByCoordinates -> Coordinates -> Bool
isVacant MaybePieceByCoordinates
maybePieceByCoordinates (Coordinates -> (Bool, Bool)) -> Coordinates -> (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ Move -> Coordinates
Component.Move.getDestination Move
move
)
) (Maybe Piece -> Bool) -> Maybe Piece -> Bool
forall a b. (a -> b) -> a -> b
$ ArrayByCoordinates (Maybe Piece)
byCoordinates ArrayByCoordinates (Maybe Piece) -> Coordinates -> Maybe Piece
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates
source where
source :: Coordinates
source = Move -> Coordinates
Component.Move.getSource Move
move