module Chess.Internal.Board (Board, Coordinates, initialBoard, emptyBoard, printBoardCompact,
                    parseCoordinate, isInsideBoard, getPiece, movePiece,
                    parseBoardCompact, printCoordinate, isEmpty, isOpponentSquare,
                    firstPieceInSquareList, iterateDirectionInsideBoard,
                    getKingSquare, rookPattern, bishopPattern, knightPattern,
                    queenPattern, isSquareThreatened, sumSquares,
                    isCheck, getSquaresWithOwner, addPiece, removePiece,
                    getPlayerPieces, getSquareColor, getSquaresWithPieces, Square(..)) where

import Data.Array
import Data.Char
import Data.List
import Data.Maybe
import Chess.Internal.Piece

data Square = Square Piece | Empty
              deriving (Square -> Square -> Bool
(Square -> Square -> Bool)
-> (Square -> Square -> Bool) -> Eq Square
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Square -> Square -> Bool
$c/= :: Square -> Square -> Bool
== :: Square -> Square -> Bool
$c== :: Square -> Square -> Bool
Eq, Int -> Square -> ShowS
[Square] -> ShowS
Square -> String
(Int -> Square -> ShowS)
-> (Square -> String) -> ([Square] -> ShowS) -> Show Square
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Square] -> ShowS
$cshowList :: [Square] -> ShowS
show :: Square -> String
$cshow :: Square -> String
showsPrec :: Int -> Square -> ShowS
$cshowsPrec :: Int -> Square -> ShowS
Show)


-- | Coordinate format:
--
-- @
-- (rank, file)
-- (0,0)          (0,7)
--    +---> file
--    |
--    |
--    v
--   rank
--  (7,0)         (7,7)
-- -
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 8 | (0,0) | (0,1) | (0,2) | (0,3) | (0,4) | (0,5) | (0,6) | (0,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 7 | (1,0) | (1,1) | (1,2) | (1,3) | (1,4) | (1,5) | (1,6) | (1,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 6 | (2,0) | (2,1) | (2,2) | (2,3) | (2,4) | (2,5) | (2,6) | (2,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 5 | (3,0) | (3,1) | (3,2) | (3,3) | (3,4) | (3,5) | (3,6) | (3,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 4 | (4,0) | (4,1) | (4,2) | (4,3) | (4,4) | (4,5) | (4,6) | (4,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 3 | (5,0) | (5,1) | (5,2) | (5,3) | (5,4) | (5,5) | (5,6) | (5,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 2 | (6,0) | (6,1) | (6,2) | (6,3) | (6,4) | (6,5) | (6,6) | (6,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
-- 1 | (7,0) | (7,1) | (7,2) | (7,3) | (7,4) | (7,5) | (7,6) | (7,7) |
--   +-------+-------+-------+-------+-------+-------+-------+-------+
--       a       b       c       d       e       f       g       h
--  @
--
type Coordinates = (Int, Int)
type Board = Array Coordinates Square

initialBoard :: Board
initialBoard :: Board
initialBoard = ((Int, Int), (Int, Int)) -> [Square] -> Board
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
0, Int
0), (Int
7, Int
7)) [Square]
rows
    where officerRow :: Color -> [Square]
officerRow Color
color = (PieceType -> Square) -> [PieceType] -> [Square]
forall a b. (a -> b) -> [a] -> [b]
map (Piece -> Square
Square (Piece -> Square) -> (PieceType -> Piece) -> PieceType -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> PieceType -> Piece
Piece Color
color) [PieceType
Rook, PieceType
Knight, PieceType
Bishop, PieceType
Queen, PieceType
King, PieceType
Bishop, PieceType
Knight, PieceType
Rook]
          pawnRow :: Color -> [Square]
pawnRow Color
color = Int -> Square -> [Square]
forall a. Int -> a -> [a]
replicate Int
8 (Square -> [Square]) -> Square -> [Square]
forall a b. (a -> b) -> a -> b
$ (Piece -> Square
Square (Piece -> Square) -> (PieceType -> Piece) -> PieceType -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> PieceType -> Piece
Piece Color
color) PieceType
Pawn
          rows :: [Square]
rows = Color -> [Square]
officerRow Color
Black [Square] -> [Square] -> [Square]
forall a. [a] -> [a] -> [a]
++ Color -> [Square]
pawnRow Color
Black [Square] -> [Square] -> [Square]
forall a. [a] -> [a] -> [a]
++ Int -> Square -> [Square]
forall a. Int -> a -> [a]
replicate Int
32 Square
Empty [Square] -> [Square] -> [Square]
forall a. [a] -> [a] -> [a]
++ Color -> [Square]
pawnRow Color
White [Square] -> [Square] -> [Square]
forall a. [a] -> [a] -> [a]
++ Color -> [Square]
officerRow Color
White

emptyBoard :: Board
emptyBoard :: Board
emptyBoard = ((Int, Int), (Int, Int)) -> [Square] -> Board
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
0, Int
0), (Int
7, Int
7)) (Square -> [Square]
forall a. a -> [a]
repeat Square
Empty)

squareToChar :: Square -> Char
squareToChar :: Square -> Char
squareToChar Square
Empty = Char
' '
squareToChar (Square Piece
p) = String -> Char
forall a. [a] -> a
head (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ Piece -> String
printPiece Piece
p

printBoardCompact :: Board -> String
printBoardCompact :: Board -> String
printBoardCompact Board
board = ShowS
toLines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Square -> ShowS) -> String -> [Square] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Square -> ShowS
f String
"" (Board -> [Square]
forall i e. Array i e -> [e]
elems Board
board)
    where f :: Square -> ShowS
f = (:) (Char -> ShowS) -> (Square -> Char) -> Square -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Square -> Char
squareToChar
          toLines :: ShowS
toLines [] = []
          toLines String
str = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
8 String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
toLines (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
8 String
str)

isInsideBoard :: Coordinates -> Bool
isInsideBoard :: (Int, Int) -> Bool
isInsideBoard (Int
i, Int
j) = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7

parseCoordinate :: String -> Maybe Coordinates
parseCoordinate :: String -> Maybe (Int, Int)
parseCoordinate [Char
column, Char
row] | (Int, Int) -> Bool
isInsideBoard (Int, Int)
coordinates = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
coordinates
                              | Bool
otherwise = Maybe (Int, Int)
forall a. Maybe a
Nothing
    where coordinates :: (Int, Int)
coordinates = (Char -> Int
ord Char
'8' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
row, Char -> Int
ord Char
column Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
parseCoordinate String
_ = Maybe (Int, Int)
forall a. Maybe a
Nothing

printCoordinate :: Coordinates -> String
printCoordinate :: (Int, Int) -> String
printCoordinate (Int
r, Int
c) = [Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c), Int -> Char
intToDigit (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)]

movePiece :: Coordinates -> Coordinates -> Board -> Maybe Board
movePiece :: (Int, Int) -> (Int, Int) -> Board -> Maybe Board
movePiece (Int, Int)
start (Int, Int)
end Board
_ | Bool -> Bool
not ((Int, Int) -> Bool
isInsideBoard (Int, Int)
start) Bool -> Bool -> Bool
|| Bool -> Bool
not ((Int, Int) -> Bool
isInsideBoard (Int, Int)
end) = Maybe Board
forall a. Maybe a
Nothing
movePiece (Int, Int)
start (Int, Int)
end Board
board = case Maybe Piece
startPiece of
                                    Maybe Piece
Nothing -> Maybe Board
forall a. Maybe a
Nothing
                                    Just Piece
piece -> Board -> Maybe Board
forall a. a -> Maybe a
Just (Board -> Maybe Board) -> Board -> Maybe Board
forall a b. (a -> b) -> a -> b
$ Board -> (Int, Int) -> Piece -> Board
addPiece Board
board' (Int, Int)
end Piece
piece
        where startPiece :: Maybe Piece
startPiece = Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
start
              board' :: Board
board' = Board -> (Int, Int) -> Board
removePiece Board
board (Int, Int)
start

addPiece :: Board -> Coordinates -> Piece -> Board
addPiece :: Board -> (Int, Int) -> Piece -> Board
addPiece Board
board (Int, Int)
coordinates = Board -> (Int, Int) -> Square -> Board
updateBoard Board
board (Int, Int)
coordinates (Square -> Board) -> (Piece -> Square) -> Piece -> Board
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> Square
Square

removePiece :: Board -> Coordinates -> Board
removePiece :: Board -> (Int, Int) -> Board
removePiece Board
board (Int, Int)
coordinates = Board -> (Int, Int) -> Square -> Board
updateBoard Board
board (Int, Int)
coordinates Square
Empty

updateBoard :: Board -> Coordinates -> Square -> Board
updateBoard :: Board -> (Int, Int) -> Square -> Board
updateBoard Board
board (Int, Int)
coordinates Square
square = Board
board Board -> [((Int, Int), Square)] -> Board
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int, Int)
coordinates, Square
square)]

getPiece :: Board -> Coordinates -> Maybe Piece
getPiece :: Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
coordinates | ((Int, Int), (Int, Int)) -> (Int, Int) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Board -> ((Int, Int), (Int, Int))
forall i e. Array i e -> (i, i)
bounds Board
board) (Int, Int)
coordinates = Square -> Maybe Piece
f (Square -> Maybe Piece) -> Square -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ Board
board Board -> (Int, Int) -> Square
forall i e. Ix i => Array i e -> i -> e
! (Int, Int)
coordinates
                           where f :: Square -> Maybe Piece
f Square
Empty = Maybe Piece
forall a. Maybe a
Nothing
                                 f (Square Piece
piece) = Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
piece
getPiece Board
_ (Int, Int)
_ = Maybe Piece
forall a. Maybe a
Nothing

isEmpty :: Board -> Coordinates -> Bool
isEmpty :: Board -> (Int, Int) -> Bool
isEmpty Board
board (Int, Int)
coordinates = Maybe Piece -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Piece -> Bool) -> Maybe Piece -> Bool
forall a b. (a -> b) -> a -> b
$ Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
coordinates

isPlayerSquare :: Board -> Color -> Coordinates -> Bool
isPlayerSquare :: Board -> Color -> (Int, Int) -> Bool
isPlayerSquare Board
board Color
player (Int, Int)
coordinates = case Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
coordinates of
                                                  Maybe Piece
Nothing -> Bool
False
                                                  Just (Piece Color
color PieceType
_) -> Color
color Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
player

isOpponentSquare :: Board -> Coordinates -> Color -> Bool
isOpponentSquare :: Board -> (Int, Int) -> Color -> Bool
isOpponentSquare Board
board (Int, Int)
coordinates Color
player = Board -> Color -> (Int, Int) -> Bool
isPlayerSquare Board
board (Color -> Color
opponent Color
player) (Int, Int)
coordinates

parseBoardCompact :: String -> Maybe Board
parseBoardCompact :: String -> Maybe Board
parseBoardCompact String
str | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
72 = Maybe Board
forall a. Maybe a
Nothing
                      | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 Bool -> Bool -> Bool
|| [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rows) [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int
8] = Maybe Board
forall a. Maybe a
Nothing
                      | Bool
otherwise = Maybe [Square]
squares Maybe [Square] -> ([Square] -> Maybe Board) -> Maybe Board
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Square] -> Maybe Board
boardFromSquares
        where rows :: [String]
rows = String -> [String]
lines String
str
              squares :: Maybe [Square]
squares = (Char -> Maybe Square) -> String -> Maybe [Square]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Maybe Square
parseSquare ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
rows)

parseSquare :: Char -> Maybe Square
parseSquare :: Char -> Maybe Square
parseSquare Char
' ' = Square -> Maybe Square
forall a. a -> Maybe a
Just Square
Empty
parseSquare Char
c = case Char -> Maybe Piece
parsePiece Char
c of
                        Maybe Piece
Nothing -> Maybe Square
forall a. Maybe a
Nothing
                        Just Piece
piece -> Square -> Maybe Square
forall a. a -> Maybe a
Just (Square -> Maybe Square) -> Square -> Maybe Square
forall a b. (a -> b) -> a -> b
$ Piece -> Square
Square Piece
piece

boardFromSquares :: [Square] -> Maybe Board
boardFromSquares :: [Square] -> Maybe Board
boardFromSquares [Square]
squares | [Square] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Square]
squares Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
64 = Maybe Board
forall a. Maybe a
Nothing
                         | Bool
otherwise = Board -> Maybe Board
forall a. a -> Maybe a
Just (Board -> Maybe Board) -> Board -> Maybe Board
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [Square] -> Board
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
0, Int
0), (Int
7, Int
7)) [Square]
squares

firstPieceInSquareList :: Board -> [Coordinates] -> Maybe Piece
firstPieceInSquareList :: Board -> [(Int, Int)] -> Maybe Piece
firstPieceInSquareList Board
board [(Int, Int)]
coordinates = case [(Int, Int)]
firstNonEmpty of
                                                   [] -> Maybe Piece
forall a. Maybe a
Nothing
                                                   ((Int, Int)
coordinate:[(Int, Int)]
_) -> Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
coordinate
        where firstNonEmpty :: [(Int, Int)]
firstNonEmpty = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Board -> (Int, Int) -> Bool
isEmpty Board
board) [(Int, Int)]
coordinates

iterateDirectionInsideBoard :: Coordinates -> (Int, Int) -> [Coordinates]
iterateDirectionInsideBoard :: (Int, Int) -> (Int, Int) -> [(Int, Int)]
iterateDirectionInsideBoard (Int, Int)
start (Int, Int)
direction = [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
tail ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int, Int) -> Bool
isInsideBoard ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, Int)) -> (Int, Int) -> [(Int, Int)]
forall a. (a -> a) -> a -> [a]
iterate ((Int, Int) -> (Int, Int) -> (Int, Int)
sumSquares (Int, Int)
direction) (Int, Int)
start

sumSquares :: (Int, Int) -> (Int, Int) -> (Int, Int)
sumSquares :: (Int, Int) -> (Int, Int) -> (Int, Int)
sumSquares (Int
x1, Int
y1) (Int
x2, Int
y2) = (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2, Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2)

getKingSquare :: Board -> Color -> Coordinates
getKingSquare :: Board -> Color -> (Int, Int)
getKingSquare Board
board Color
player = Maybe (Int, Int) -> (Int, Int)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Square -> [((Int, Int), Square)] -> Maybe (Int, Int)
forall a b. Eq a => a -> [(b, a)] -> Maybe b
rlookup (Piece -> Square
Square (Color -> PieceType -> Piece
Piece Color
player PieceType
King)) ([((Int, Int), Square)] -> Maybe (Int, Int))
-> [((Int, Int), Square)] -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ Board -> [((Int, Int), Square)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs Board
board
        where rlookup :: a -> [(b, a)] -> Maybe b
rlookup a
x = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x ([(a, b)] -> Maybe b)
-> ([(b, a)] -> [(a, b)]) -> [(b, a)] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (a, b)) -> [(b, a)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> (a, b)
forall b a. (b, a) -> (a, b)
swap
              swap :: (b, a) -> (a, b)
swap (b
x, a
y) = (a
y, b
x)

rookPattern :: [(Int, Int)]
rookPattern :: [(Int, Int)]
rookPattern = [(-Int
1, Int
0), (Int
1, Int
0), (Int
0, -Int
1), (Int
0, Int
1)]

bishopPattern :: [(Int, Int)]
bishopPattern :: [(Int, Int)]
bishopPattern = [(-Int
1, -Int
1), (-Int
1, Int
1), (Int
1, -Int
1), (Int
1, Int
1)]

queenPattern :: [(Int, Int)]
queenPattern :: [(Int, Int)]
queenPattern = [(Int, Int)]
rookPattern [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
bishopPattern

knightPattern :: [(Int, Int)]
knightPattern :: [(Int, Int)]
knightPattern = [(-Int
2, -Int
1), (-Int
1, -Int
2), (Int
1, -Int
2), (Int
2, -Int
1), (-Int
2, Int
1), (-Int
1, Int
2), (Int
1, Int
2), (Int
2, Int
1)]

isSquareThreatened :: Board -> Color -> Coordinates -> Bool
isSquareThreatened :: Board -> Color -> (Int, Int) -> Bool
isSquareThreatened Board
board Color
opponentPlayer (Int, Int)
coords = Bool
knightsThreaten Bool -> Bool -> Bool
|| Bool
pawnsThreaten Bool -> Bool -> Bool
|| Bool
otherPiecesThreaten Bool -> Bool -> Bool
|| Bool
kingsThreaten Bool -> Bool -> Bool
|| Bool
rookOrQueenThreatens Bool -> Bool -> Bool
|| Bool
bishopOrQueenThreatens
        where knightSquares :: [(Int, Int)]
knightSquares = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> (Int, Int) -> (Int, Int)
sumSquares (Int, Int)
coords) [(Int, Int)]
knightPattern
              knightsThreaten :: Bool
knightsThreaten = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int, Int) -> Bool
isOpponentKnight [(Int, Int)]
knightSquares
              isOpponentKnight :: (Int, Int) -> Bool
isOpponentKnight (Int, Int)
square = case Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
square of
                                                Just (Piece Color
player PieceType
Knight) -> Color
player Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
opponentPlayer
                                                Maybe Piece
_ -> Bool
False
              pawnsThreaten :: Bool
pawnsThreaten = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int, Int) -> Bool
isOpponentPawn ((Int, Int) -> Bool)
-> ((Int, Int) -> (Int, Int)) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> (Int, Int) -> (Int, Int)
sumSquares (Int, Int)
coords) [(Int, Int)]
pawnSquares
              pawnSquares :: [(Int, Int)]
pawnSquares = case Color
opponentPlayer of
                                    Color
White -> [(Int
1, -Int
1), (Int
1, Int
1)]
                                    Color
Black -> [(-Int
1, -Int
1), (-Int
1, Int
1)]
              isOpponentPawn :: (Int, Int) -> Bool
isOpponentPawn (Int, Int)
square = case Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
square of
                                              Just (Piece Color
player PieceType
Pawn) -> Color
player Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
opponentPlayer
                                              Maybe Piece
_ -> Bool
False
              otherPiecesThreaten :: Bool
otherPiecesThreaten = Bool
False
              kingSquares :: [(Int, Int)]
kingSquares = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> (Int, Int) -> (Int, Int)
sumSquares (Int, Int)
coords) [(Int, Int)]
queenPattern
              kingsThreaten :: Bool
kingsThreaten = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int, Int) -> Bool
isOpponentKing [(Int, Int)]
kingSquares
              isOpponentKing :: (Int, Int) -> Bool
isOpponentKing (Int, Int)
square  = case Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
square of
                                                Just (Piece Color
player PieceType
King) -> Color
player Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
opponentPlayer
                                                Maybe Piece
_ -> Bool
False
              potentialOpponentRookQueenPieces :: [Piece]
potentialOpponentRookQueenPieces = ((Int, Int) -> Maybe Piece) -> [(Int, Int)] -> [Piece]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Board -> [(Int, Int)] -> Maybe Piece
firstPieceInSquareList Board
board ([(Int, Int)] -> Maybe Piece)
-> ((Int, Int) -> [(Int, Int)]) -> (Int, Int) -> Maybe Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> (Int, Int) -> [(Int, Int)]
iterateDirectionInsideBoard (Int, Int)
coords) [(Int, Int)]
rookPattern
              rookOrQueenThreatens :: Bool
rookOrQueenThreatens = (Piece -> Bool) -> [Piece] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Piece -> Bool
isOpponentRookOrQueen [Piece]
potentialOpponentRookQueenPieces
              isOpponentRookOrQueen :: Piece -> Bool
isOpponentRookOrQueen (Piece Color
color PieceType
piecetype) = Color
color Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
opponentPlayer Bool -> Bool -> Bool
&& PieceType
piecetype PieceType -> [PieceType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PieceType
Rook, PieceType
Queen]
              potentialOpponentBishopQueenPieces :: [Piece]
potentialOpponentBishopQueenPieces = ((Int, Int) -> Maybe Piece) -> [(Int, Int)] -> [Piece]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Board -> [(Int, Int)] -> Maybe Piece
firstPieceInSquareList Board
board ([(Int, Int)] -> Maybe Piece)
-> ((Int, Int) -> [(Int, Int)]) -> (Int, Int) -> Maybe Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> (Int, Int) -> [(Int, Int)]
iterateDirectionInsideBoard (Int, Int)
coords) [(Int, Int)]
bishopPattern
              bishopOrQueenThreatens :: Bool
bishopOrQueenThreatens = (Piece -> Bool) -> [Piece] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Piece -> Bool
isOpponentBishopOrQueen [Piece]
potentialOpponentBishopQueenPieces
              isOpponentBishopOrQueen :: Piece -> Bool
isOpponentBishopOrQueen (Piece Color
color PieceType
piecetype) = Color
color Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
opponentPlayer Bool -> Bool -> Bool
&& PieceType
piecetype PieceType -> [PieceType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PieceType
Bishop, PieceType
Queen]

isCheck :: Board -> Color -> Bool
isCheck :: Board -> Color -> Bool
isCheck Board
board Color
player = Board -> Color -> (Int, Int) -> Bool
isSquareThreatened Board
board (Color -> Color
opponent Color
player) (Int, Int)
kingSquare
        where kingSquare :: (Int, Int)
kingSquare = Board -> Color -> (Int, Int)
getKingSquare Board
board Color
player

getSquaresWithOwner :: Board -> Color -> [Coordinates]
getSquaresWithOwner :: Board -> Color -> [(Int, Int)]
getSquaresWithOwner Board
board Color
player = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Board -> Color -> (Int, Int) -> Bool
isPlayerSquare Board
board Color
player) (Board -> [(Int, Int)]
forall i e. Ix i => Array i e -> [i]
indices Board
board)

getSquaresWithPieces :: Board -> PieceType -> [Coordinates]
getSquaresWithPieces :: Board -> PieceType -> [(Int, Int)]
getSquaresWithPieces Board
board PieceType
piecetype = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Board -> PieceType -> (Int, Int) -> Bool
isPieceSquare Board
board PieceType
piecetype) (Board -> [(Int, Int)]
forall i e. Ix i => Array i e -> [i]
indices Board
board)

isPieceSquare :: Board -> PieceType -> Coordinates -> Bool
isPieceSquare :: Board -> PieceType -> (Int, Int) -> Bool
isPieceSquare Board
board PieceType
piecetype (Int, Int)
square = case Board -> (Int, Int) -> Maybe Piece
getPiece Board
board (Int, Int)
square of
                                               Just (Piece Color
_ PieceType
t) -> PieceType
t PieceType -> PieceType -> Bool
forall a. Eq a => a -> a -> Bool
== PieceType
piecetype
                                               Maybe Piece
Nothing -> Bool
False

getPlayerPieces :: Board -> Color -> [PieceType]
getPlayerPieces :: Board -> Color -> [PieceType]
getPlayerPieces Board
board Color
player = ((Int, Int) -> PieceType) -> [(Int, Int)] -> [PieceType]
forall a b. (a -> b) -> [a] -> [b]
map (Piece -> PieceType
typeFromPiece (Piece -> PieceType)
-> ((Int, Int) -> Piece) -> (Int, Int) -> PieceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Piece -> Piece
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Piece -> Piece)
-> ((Int, Int) -> Maybe Piece) -> (Int, Int) -> Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board -> (Int, Int) -> Maybe Piece
getPiece Board
board) (Board -> Color -> [(Int, Int)]
getSquaresWithOwner Board
board Color
player)
        where typeFromPiece :: Piece -> PieceType
typeFromPiece (Piece Color
_ PieceType
pieceType) = PieceType
pieceType

getSquareColor :: Coordinates -> Color
getSquareColor :: (Int, Int) -> Color
getSquareColor (Int
row, Int
column) | Int -> Bool
forall a. Integral a => a -> Bool
even (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
column) = Color
White
                             | Bool
otherwise = Color
Black