module BoardTests where import Chess.Internal.Piece import Chess.Internal.Board import Data.Maybe import TestUtils import Test.Hspec boardSpec :: IO () boardSpec = hspec $ describe "Board" $ do boardPrintingSpec isInsideBoardSpec parseCoordinateSpec printCoordinateSpec getPieceSpec movePieceSpec parseBoardCompactSpec isEmptySpec isOpponentSquareSpec firstPieceInSquareListSpec iterateDirectionInsideBoardSpec getKingSquareSpec isSquareThreatenedSpec isCheckSpec getSquaresWithOwnerSpec getPlayerPiecesSpec getSquareColorSpec getSquaresWithPiecesSpec boardPrintingSpec :: Spec boardPrintingSpec = describe "printBoardCompact" $ do it "should print initial board position correctly" $ printBoardCompact initialBoard `shouldBe` "rnbqkbnr\npppppppp\n \n \n \n \nPPPPPPPP\nRNBQKBNR\n" it "should print empty board correctly" $ printBoardCompact emptyBoard `shouldBe` " \n \n \n \n \n \n \n \n" isInsideBoardSpec :: Spec isInsideBoardSpec = describe "isInsideBoard" $ it "should detect correctly whether given coordinates are inside board bounds" $do isInsideBoard (0, 0) `shouldBe` True isInsideBoard (7, 7) `shouldBe` True isInsideBoard (3, 5) `shouldBe` True isInsideBoard (-1, 5) `shouldBe` False isInsideBoard (3, -1) `shouldBe` False isInsideBoard (8, 5) `shouldBe` False isInsideBoard (3, 8) `shouldBe` False parseCoordinateSpec :: Spec parseCoordinateSpec = describe "parseCoordinate" $ do it "should parse legal coordinates correctly" $ do parseCoordinate "a8" `shouldBe` Just (0, 0) parseCoordinate "b8" `shouldBe` Just (0, 1) parseCoordinate "c8" `shouldBe` Just (0, 2) parseCoordinate "a7" `shouldBe` Just (1, 0) parseCoordinate "a6" `shouldBe` Just (2, 0) parseCoordinate "a1" `shouldBe` Just (7, 0) parseCoordinate "h8" `shouldBe` Just (0, 7) parseCoordinate "h1" `shouldBe` Just (7, 7) parseCoordinate "f5" `shouldBe` Just (3, 5) it "should parse not parse invalid coordinates" $ do parseCoordinate "B5" `shouldBe` Nothing parseCoordinate "F5" `shouldBe` Nothing parseCoordinate "12" `shouldBe` Nothing parseCoordinate "i1" `shouldBe` Nothing parseCoordinate "a9" `shouldBe` Nothing parseCoordinate "a-1" `shouldBe` Nothing parseCoordinate "foobar" `shouldBe` Nothing printCoordinateSpec :: Spec printCoordinateSpec = describe "printCoordinate" $ it "should print legal coordinates correctly" $ do printCoordinate (0, 0) `shouldBe` "a8" printCoordinate (0, 1) `shouldBe` "b8" printCoordinate (0, 2) `shouldBe` "c8" printCoordinate (1, 0) `shouldBe` "a7" printCoordinate (2, 0) `shouldBe` "a6" printCoordinate (3, 5) `shouldBe` "f5" getPieceSpec :: Spec getPieceSpec = describe "getPiece" $ do it "should return Nothing for invalid coordinates" $ do getPiece initialBoard (-1, -1) `shouldBe` Nothing getPiece initialBoard (8, 8) `shouldBe` Nothing it "should return Nothing for empty squares" $ getPiece initialBoard (4, 4) `shouldBe` Nothing it "should return piece for squares that have pieces" $ do getPiece initialBoard (0, 0) `shouldBe` Just (Piece Black Rook) getPiece initialBoard (0, 3) `shouldBe` Just (Piece Black Queen) getPiece initialBoard (7, 4) `shouldBe` Just (Piece White King) movePieceSpec :: Spec movePieceSpec = describe "movePiece" $ do it "should return Nothing for invalid coordinates" $ do movePiece (0, 0) (8, 8) initialBoard `shouldBe` Nothing movePiece (-1, -1) (7, 7) initialBoard `shouldBe` Nothing it "should return Nothing when start square does not have a piece" $ movePiece (4, 4) (0, 0) initialBoard `shouldBe` Nothing it "should return new board when start square has a piece and end coordinate is valid" $ do printBoardCompact (fromJust (movePiece (0, 0) (4, 4) initialBoard)) `shouldBe` " nbqkbnr\npppppppp\n \n \n r \n \nPPPPPPPP\nRNBQKBNR\n" printBoardCompact (fromJust (movePiece (0, 0) (0, 0) initialBoard)) `shouldBe` "rnbqkbnr\npppppppp\n \n \n \n \nPPPPPPPP\nRNBQKBNR\n" printBoardCompact (fromJust (movePiece (0, 0) (0, 1) initialBoard)) `shouldBe` " rbqkbnr\npppppppp\n \n \n \n \nPPPPPPPP\nRNBQKBNR\n" parseBoardCompactSpec :: Spec parseBoardCompactSpec = describe "parseBoardCompact" $ do it "should be able to parse the initial board" $ parseBoardCompact (printBoardCompact initialBoard) `shouldBe` Just initialBoard it "should be able to parse the empty board" $ parseBoardCompact " \n \n \n \n \n \n \n \n" `shouldBe` Just emptyBoard it "should return Nothing with invalid board (too short row)" $ parseBoardCompact " \n \n \n \n \n \n \n \n \n" `shouldBe` Nothing it "should return Nothing with invalid board (too few rows)" $ parseBoardCompact " \n \n \n \n \n \n \n \n" `shouldBe` Nothing it "should return Nothing with empty input" $ parseBoardCompact "" `shouldBe` Nothing it "should return Nothing with garbage input" $ parseBoardCompact "foobar" `shouldBe` Nothing it "should return Nothing with invalid board (invalid pieces)" $ do parseBoardCompact " \n xxx \n \n \n \n \n \n \n" `shouldBe` Nothing parseBoardCompact "rnbqkbnr\nppxppppp\n \n \n \n \nPPPPPPPP\nRNBQKBNR\n" `shouldBe` Nothing it "should return Nothing with invalid board (empty row)" $ parseBoardCompact "rnbqkbnr\npppppppp\n \n\n \n \n \nPPPPPPPP\nRNBQKBNR\n" `shouldBe` Nothing it "should return Nothing with invalid board (missing row)" $ parseBoardCompact "pppppppp\n \n \n \n \nPPPPPPPP\nRNBQKBNR\n" `shouldBe` Nothing isEmptySpec :: Spec isEmptySpec = describe "isEmpty" $ do it "should return True for empty squares" $ isEmpty initialBoard (4, 4) `shouldBe` True it "should return True for squares out of bounds" $ do isEmpty initialBoard (-1, -1) `shouldBe` True isEmpty initialBoard (8, 8) `shouldBe` True it "should return False for squares containing pieces" $ do isEmpty initialBoard (0, 0) `shouldBe` False isEmpty initialBoard (0, 3) `shouldBe` False isEmpty initialBoard (7, 4) `shouldBe` False isOpponentSquareSpec :: Spec isOpponentSquareSpec = describe "isOpponentSquare" $ do it "should return False for empty squares" $ isOpponentSquare initialBoard (4, 4) White `shouldBe` False it "should return False for squares out of bounds" $ do isOpponentSquare initialBoard (-1, -1) Black `shouldBe` False isOpponentSquare initialBoard (8, 8) White `shouldBe` False it "should return False for squares that have own pieces" $ do isOpponentSquare initialBoard (0, 0) Black `shouldBe` False isOpponentSquare initialBoard (7, 4) White `shouldBe` False it "should return True for squares that have opponent pieces" $ do isOpponentSquare initialBoard (0, 3) White `shouldBe` True isOpponentSquare initialBoard (7, 4) Black `shouldBe` True firstPieceInSquareListSpec :: Spec firstPieceInSquareListSpec = describe "firstPieceInSquareList" $ do it "should return Nothing if none of the coordinates contain any piece" $ firstPieceInSquareList initialBoard [(4, 1), (4, 2), (4, 3)] `shouldBe` Nothing it "should return the piece of the first coordinate from the list that contains a piece" $ do firstPieceInSquareList initialBoard [(4, 1), (5, 2), (6, 3), (7, 4)] `shouldBe` Just (Piece White Pawn) firstPieceInSquareList initialBoard [(7, 4), (0, 4)] `shouldBe` Just (Piece White King) iterateDirectionInsideBoardSpec :: Spec iterateDirectionInsideBoardSpec = describe "iterateDirectionInsideBoard" $ do it "should return empty list for square next to border with direction towards border" $ iterateDirectionInsideBoard (4, 0) (0, -1) `shouldBe` [] it "should return the list of coordinates that you get when you start walking from a square towards a certain direction" $ do iterateDirectionInsideBoard (4, 1) (-1, 0) `shouldBe` [(3,1),(2,1),(1,1),(0,1)] iterateDirectionInsideBoard (4, 1) (1, 1) `shouldBe` [(5,2),(6,3),(7,4)] getKingSquareSpec :: Spec getKingSquareSpec = describe "getKingSquare" $ it "should return the coordinates of the square where king is currently" $ do getKingSquare initialBoard White `shouldBe` coord "e1" getKingSquare initialBoard Black `shouldBe` coord "e8" isSquareThreatenedSpec :: Spec isSquareThreatenedSpec = describe "isSquareThreatened" $ do it "should return False for player square if no opponent piece threatens the given square" $ do isSquareThreatened initialBoard Black (coord "e1") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "g2") `shouldBe` False it "should return False for empty square if no opponent piece threatens the given square" $ do isSquareThreatened initialBoard Black (coord "e4") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "h5") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "d8") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") Black (coord "f4") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "d8") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "h6") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "b5") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "c4") `shouldBe` False it "should return True for player square if player piece threatens the given square" $ isSquareThreatened initialBoard White (coord "e1") `shouldBe` True it "should not consider Pawn movement square threatened" $ do isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "c6") `shouldBe` False isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "e5") `shouldBe` False it "should detect when Pawn threatens a square" $ do isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") Black (coord "f1") `shouldBe` True isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") Black (coord "h1") `shouldBe` True it "should detect when Knight threatens a square" $ do isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "g5") `shouldBe` True isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "b4") `shouldBe` True isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "f4") `shouldBe` True it "should detect when Bishop threatens a square" $ isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "g8") `shouldBe` True it "should detect when Queen threatens a square" $ isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") Black (coord "b1") `shouldBe` True it "should detect when King threatens a square" $ isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") Black (coord "d8") `shouldBe` True it "should detect when multiple pieces threaten a square" $ do isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "d5") `shouldBe` True isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "g4") `shouldBe` True isSquareThreatened (fenBoard "rnb1kb1r/ppp1p2p/4Bp2/2Pp4/1q2P1n1/7N/P1NP1PpP/R1BQK2R w KQkq - 0 1") White (coord "f1") `shouldBe` True isCheckSpec :: Spec isCheckSpec = describe "isCheck" $ do it "should return False for initial board" $ do isCheck initialBoard White `shouldBe` False isCheck initialBoard Black `shouldBe` False it "should return True when opponent threatens the king square" $ do isCheck (fenBoard "rnbqkbnr/pppp2pp/5p2/4p2Q/4P3/3P4/PPP2PPP/RNB1KBNR b KQkq - 1 3") Black `shouldBe` True isCheck (fenBoard "rnbqk2r/pppp2bp/3N2pn/4pp1Q/4P3/3P4/PPP2PPP/RNB1KB1R b KQkq - 1 7") Black `shouldBe` True isCheck (fenBoard "rnbq3r/pppp2bp/3Nk1pn/3Ppp1Q/4P3/8/PPP2PPP/RNB1KB1R b KQ - 0 9") Black `shouldBe` True isCheck (fenBoard "8/5r2/4K1q1/4p3/3k4/8/8/8 w - - 0 7") White `shouldBe` True isCheck (fenBoard "r3k2r/ppp2p1p/2n1p1p1/8/2B2P1q/2NPb1n1/PP4PP/R2Q3K w kq - 0 8") White `shouldBe` True it "should return False when king square is not threatened by the opponent" $ do isCheck (fenBoard "rnbqkbnr/pppp2pp/5p2/4p2Q/4P3/3P4/PPP2PPP/RNB1KBNR b KQkq - 1 3") White `shouldBe` False isCheck (fenBoard "8/5r2/4K1q1/4p3/3k4/8/8/8 w - - 0 7") Black `shouldBe` False getSquaresWithOwnerSpec :: Spec getSquaresWithOwnerSpec = describe "getSquaresWithOwner" $ it "should return coordinates which have player pieces" $ do getSquaresWithOwner (fenBoard "8/k7/8/8/6p1/7P/6PK/8 w - - 0 1") Black `shouldMatchList` [coord "a7", coord "g4"] getSquaresWithOwner (fenBoard "8/k7/8/8/6p1/7P/6PK/8 w - - 0 1") White `shouldMatchList` [coord "g2", coord "h2", coord "h3"] getPlayerPiecesSpec :: Spec getPlayerPiecesSpec = describe "getPlayerPieces" $ it "should return list of pieces a player owns" $ do getPlayerPieces (fenBoard "4k3/8/5np1/8/8/2BB4/2Q5/4K3 w - - 0 1") White `shouldMatchList` [Bishop, Bishop, Queen, King] getPlayerPieces (fenBoard "4k3/8/5np1/8/8/2BB4/2Q5/4K3 w - - 0 1") Black `shouldMatchList` [Knight, Pawn, King] getSquareColorSpec :: Spec getSquareColorSpec = describe "getSquareColor" $ it "should return the color of the square in the given coordinate" $ do getSquareColor (coord "a1") `shouldBe` Black getSquareColor (coord "c1") `shouldBe` Black getSquareColor (coord "g5") `shouldBe` Black getSquareColor (coord "d8") `shouldBe` Black getSquareColor (coord "h8") `shouldBe` Black getSquareColor (coord "a2") `shouldBe` White getSquareColor (coord "b5") `shouldBe` White getSquareColor (coord "f3") `shouldBe` White getSquareColor (coord "h1") `shouldBe` White getSquareColor (coord "a8") `shouldBe` White getSquaresWithPiecesSpec :: Spec getSquaresWithPiecesSpec = describe "getSquaresWithPieces" $ it "should return list of coordinates that have given piecetype on them" $ do getSquaresWithPieces initialBoard Rook `shouldMatchList` map coord ["a1", "h1", "a8", "h8"] getSquaresWithPieces initialBoard Queen `shouldMatchList` map coord ["d1", "d8"]