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