hchesslib 0.1.0.0 → 0.2.0.0
raw patch · 17 files changed
+1188/−17 lines, 17 files
Files
- README.md +14/−0
- hchesslib.cabal +21/−3
- src/Chess.hs +14/−3
- src/Chess/Internal/Board.hs +4/−4
- src/Chess/Internal/FEN.hs +1/−2
- src/Chess/Internal/Move.hs +3/−3
- src/Chess/Internal/Piece.hs +1/−1
- src/Chess/UI.hs +81/−0
- test/Chess/BoardTests.hs +306/−0
- test/Chess/FENTests.hs +68/−0
- test/Chess/GameTests.hs +173/−0
- test/Chess/MoveTests.hs +339/−0
- test/Chess/NotationTests.hs +64/−0
- test/Chess/PieceTests.hs +43/−0
- test/Chess/TestUtils.hs +15/−0
- test/Chess/UITests.hs +39/−0
- test/Spec.hs +2/−1
README.md view
@@ -3,3 +3,17 @@ [](https://travis-ci.org/nablaa/hchesslib) hchesslib is a simple chess library for Haskell.++## Building++Building the library inside cabal sandbox:++ cabal sandbox init+ cabal install --only-dependencies --enable-tests+ cabal build++## Running tests++Running unit tests after the library has been built:++ cabal test
hchesslib.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hchesslib-version: 0.1.0.0+version: 0.2.0.0 synopsis: Chess library description: Library implementing chess rules. license: GPL-2@@ -24,7 +24,7 @@ Default-Language: Haskell2010 Hs-Source-Dirs: src - exposed-modules: Chess, Chess.FEN+ exposed-modules: Chess, Chess.FEN, Chess.UI other-modules: Chess.Internal.Piece, Chess.Internal.Board,@@ -43,8 +43,26 @@ Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: src, test, test/Chess- Ghc-Options: -Wall -Werror+ Ghc-Options: -Wall Main-Is: Spec.hs++ Other-modules: BoardTests,+ Chess,+ Chess.FEN,+ Chess.UI,+ Chess.Internal.Board,+ Chess.Internal.FEN,+ Chess.Internal.Game,+ Chess.Internal.Move,+ Chess.Internal.Notation,+ Chess.Internal.Piece,+ FENTests,+ GameTests,+ MoveTests,+ NotationTests,+ PieceTests,+ TestUtils,+ UITests Build-Depends: base >= 4 && < 5 , hspec >= 1.5
src/Chess.hs view
@@ -17,6 +17,7 @@ Chess.Internal.Piece.Color(..), Chess.Internal.Piece.Piece(..), Chess.Internal.Piece.PieceType(..),+ Chess.Internal.Move.Move, board, fullMoveNumber, isCheckmate,@@ -27,6 +28,8 @@ newGame, pieceAt, winner,+ legalMoves,+ applyMove, ) where import Chess.Internal.Board@@ -67,9 +70,7 @@ -> String -- ^ Move in coordinate notation. E.g. "e2-e4" or "b1-c3" -> Maybe GameState move game moveStr = do m <- N.parseMove game moveStr- case G.applyMove game m of- Left _ -> Nothing- Right game' -> Just game'+ applyMove game m -- | Current board state in the game board :: GameState -> Board@@ -89,3 +90,13 @@ -- | Full move number. Incremented after black's move. fullMoveNumber :: GameState -> Integer fullMoveNumber = moveNumber++-- | Get all legal moves in the position+legalMoves :: GameState -> [Move]+legalMoves = generateAllMoves++-- | Apply a move+applyMove :: GameState -> Move -> Maybe GameState+applyMove game m = case G.applyMove game m of+ Left _ -> Nothing+ Right game' -> Just game'
src/Chess/Internal/Board.hs view
@@ -75,8 +75,8 @@ isInsideBoard (i, j) = i >= 0 && i <= 7 && j >= 0 && j <= 7 parseCoordinate :: String -> Maybe Coordinates-parseCoordinate (column:row:[]) | isInsideBoard coordinates = Just coordinates- | otherwise = Nothing+parseCoordinate [column, row] | isInsideBoard coordinates = Just coordinates+ | otherwise = Nothing where coordinates = (ord '8' - ord row, ord column - ord 'a') parseCoordinate _ = Nothing @@ -170,7 +170,7 @@ isOpponentKnight square = case getPiece board square of Just (Piece player Knight) -> player == opponentPlayer _ -> False- pawnsThreaten = any isOpponentPawn $ map (sumSquares coords) pawnSquares+ pawnsThreaten = any (isOpponentPawn . sumSquares coords) pawnSquares pawnSquares = case opponentPlayer of White -> [(1, -1), (1, 1)] Black -> [(-1, -1), (-1, 1)]@@ -210,5 +210,5 @@ where typeFromPiece (Piece _ pieceType) = pieceType getSquareColor :: Coordinates -> Color-getSquareColor (row, column) | (row + column) `mod` 2 == 0 = White+getSquareColor (row, column) | even (row + column) = White | otherwise = Black
src/Chess/Internal/FEN.hs view
@@ -5,7 +5,6 @@ import Chess.Internal.Piece import Data.List import Data.Char-import Data.Maybe writeBoard :: Board -> String writeBoard = intercalate "/" . lines . concatMap emptyToNum . group . printBoardCompact@@ -74,7 +73,7 @@ else Nothing readMaybe :: Read a => String -> Maybe a-readMaybe = fmap fst . listToMaybe . filter (null . snd) . reads+readMaybe = fmap fst . find (null . snd) . reads split :: (Char -> Bool) -> String -> [String] split p str = case dropWhile p str of
src/Chess/Internal/Move.hs view
@@ -188,9 +188,9 @@ castlingSquares Black Short = [(0, 5), (0, 6)] patternMoves :: GameState -> Coordinates -> [(Int, Int)] -> [Move]-patternMoves game start pattern- = concat [movementsInDirection game start dir | dir <- pattern]- ++ concat [capturesInDirection game start dir | dir <- pattern]+patternMoves game start pattern'+ = concat [movementsInDirection game start dir | dir <- pattern']+ ++ concat [capturesInDirection game start dir | dir <- pattern'] movementsInDirection :: GameState -> Coordinates -> (Int, Int) -> [Move] movementsInDirection game start direction = map (Movement piece start) squares
src/Chess/Internal/Piece.hs view
@@ -1,5 +1,5 @@ module Chess.Internal.Piece (Piece(..), Color(..), PieceType(..), opponent, printPiece,- parsePiece, parsePieceType) where+ parsePiece, pieceChars, parsePieceType) where import Data.Char
+ src/Chess/UI.hs view
@@ -0,0 +1,81 @@+-- |+-- Module : Chess+-- Copyright : Miika-Petteri Matikainen 2021+-- License : GPL-2+--+-- Maintainer : miikapetteri@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- Visualize chess games+module Chess.UI (+ printBoard,+ coordinateNotation+ ) where++import Data.Array+import Data.List+import Data.Char+import Data.Maybe+import Chess.Internal.Board+import Chess.Internal.Piece+import Chess.Internal.Move++-- | Prints the board in ASCII.+--+-- Example for the initial position:+-- @+--+-- +---+---+---+---+---+---+---+---++-- 8 | r | n | b | q | k | b | n | r |+-- +---+---+---+---+---+---+---+---++-- 7 | p | p | p | p | p | p | p | p |+-- +---+---+---+---+---+---+---+---++-- 6 | | | | | | | | |+-- +---+---+---+---+---+---+---+---++-- 5 | | | | | | | | |+-- +---+---+---+---+---+---+---+---++-- 4 | | | | | | | | |+-- +---+---+---+---+---+---+---+---++-- 3 | | | | | | | | |+-- +---+---+---+---+---+---+---+---++-- 2 | P | P | P | P | P | P | P | P |+-- +---+---+---+---+---+---+---+---++-- 1 | R | N | B | Q | K | B | N | R |+-- +---+---+---+---+---+---+---+---++-- a b c d e f g h+-- @+printBoard :: Board -> String+printBoard = addCoordinates . printRows . intoRows . elems+ where intoRows [] = []+ intoRows xs = take 8 xs : intoRows (drop 8 xs)++addCoordinates :: String -> String+addCoordinates str = unlines (zipWith (++) numbers (lines str)) ++ chars+ where numbers = lines $ unlines $ [" \n" ++ intToDigit n : " " | n <- reverse [1..8]] ++ [" "]+ chars = " a b c d e f g h\n"++printRows :: [[Square]] -> String+printRows rows = line ++ intercalate line (map printRow rows) ++ line+ where line = concat (replicate 8 "+---") ++ "+" ++ "\n"++printRow :: [Square] -> String+printRow row = sep ++ intercalate sep (map printSquare row) ++ sep ++ "\n"+ where sep = "|"++printSquare :: Square -> String+printSquare Empty = " "+printSquare (Square p) = " " ++ printPiece p ++ " "++-- | Prints the move in coordinate notation.+-- E.g. "e2-e4", "g1-g3", "b2-c1q"+coordinateNotation :: Move -> String+coordinateNotation (Movement _ c1 c2) = printCoordinate c1 ++ "-" ++ printCoordinate c2+coordinateNotation (Capture _ c1 c2) = printCoordinate c1 ++ "-" ++ printCoordinate c2+coordinateNotation (EnPassant _ c1 c2) = printCoordinate c1 ++ "-" ++ printCoordinate c2+coordinateNotation (PawnDoubleMove _ c1 c2) = printCoordinate c1 ++ "-" ++ printCoordinate c2+coordinateNotation (Promotion _ c1 c2 p) = printCoordinate c1 ++ "-" ++ printCoordinate c2 ++ [toLower (fromJust (lookup p pieceChars))]+coordinateNotation (Castling White Short) = "e1-g1"+coordinateNotation (Castling White Long) = "e1-c1"+coordinateNotation (Castling Black Short) = "e8-g8"+coordinateNotation (Castling Black Long) = "e8-c8"
+ test/Chess/BoardTests.hs view
@@ -0,0 +1,306 @@+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"]
+ test/Chess/FENTests.hs view
@@ -0,0 +1,68 @@+module FENTests where++import Chess.Internal.Piece+import Chess.Internal.Board+import Chess.FEN+import Chess.Internal.Move+import Test.Hspec++fenSpec :: IO ()+fenSpec = hspec $+ describe "FEN" $ do+ writeFENSpec+ readFENSpec++writeFENSpec :: Spec+writeFENSpec =+ describe "writeFEN" $ do+ it "should serialize initial game state correctly" $+ writeFEN initialState `shouldBe` "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"++ it "should serialize En Passant move and move counters correctly" $+ writeFEN (Chess.Internal.Move.State initialBoard Black [] [] (parseCoordinate "e3") 4 14) `shouldBe` "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR b - e3 4 14"++ it "should serialize castlings correctly" $ do+ writeFEN (Chess.Internal.Move.State initialBoard White [] [Long] (parseCoordinate "c6") 0 9) `shouldBe` "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w q c6 0 9"+ writeFEN (Chess.Internal.Move.State initialBoard White [Long] [Short] (parseCoordinate "c6") 0 9) `shouldBe` "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w Qk c6 0 9"++readFENSpec :: Spec+readFENSpec =+ describe "readFEN" $ do+ it "should read initial game state FEN correctly" $+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" `shouldBe` Just initialState++ it "should read FEN with castlings, En Passant and move counters correctly" $ do+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w Kq e3 7 14" `shouldBe` Just (Chess.Internal.Move.State initialBoard White [Short] [Long] (parseCoordinate "e3") 7 14)+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w - - 10 42" `shouldBe` Just (Chess.Internal.Move.State initialBoard White [] [] Nothing 10 42)++ it "should not read FEN with missing castling information" $+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w - 0 1" `shouldBe` Nothing++ it "should not read FEN with invalid player information" $+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR K KQkq - 0 1" `shouldBe` Nothing++ it "should not read FEN with invalid move counter information" $ do+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - a 1" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 a" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w - - -1 1" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w - - 0 0" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w - - 0 -1" `shouldBe` Nothing++ it "should not read FEN with invalid board" $ do+ readFEN "rnbqkbnr/pppppppp/8/8/7/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" `shouldBe` Nothing+ readFEN "nbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" `shouldBe` Nothing++ it "should not read FEN with invalid castling information" $ do+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KKkq - 0 1" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w qKqQ - 0 1" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkK - 0 1" `shouldBe` Nothing++ it "should not read FEN with invalid En Passant square" $ do+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq a9 0 1" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq i8 0 1" `shouldBe` Nothing+ readFEN "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq 44 0 1" `shouldBe` Nothing++ it "should not read garbage" $ do+ readFEN "foobar" `shouldBe` Nothing+ readFEN "" `shouldBe` Nothing+ readFEN "1 2 3 4 5 6" `shouldBe` Nothing
+ test/Chess/GameTests.hs view
@@ -0,0 +1,173 @@+module GameTests where++import Chess.FEN+import Chess.Internal.Piece+import Chess.Internal.Move+import Chess.Internal.Game+import TestUtils+import Test.Hspec++gameSpec :: IO ()+gameSpec = hspec $+ describe "Game" $ do+ applyMoveSpec+ isCheckmateSpec+ isStalemateSpec+ isInsufficientMaterialSpec+ isDrawSpec+ getWinnerSpec++applyMoveSpec :: Spec+applyMoveSpec =+ describe "applyMove" $ do+ it "should update board, player and full move counter correctly" $+ testApplyingMove "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" (Movement (Piece White Pawn) (coord "e2") (coord "e3")) "rnbqkbnr/pppppppp/8/8/8/4P3/PPPP1PPP/RNBQKBNR b KQkq - 0 1"++ it "should update en passant square for white correctly" $+ testApplyingMove "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" (PawnDoubleMove (Piece White Pawn) (coord "e2") (coord "e4")) "rnbqkbnr/pppppppp/8/8/4P3/8/PPPP1PPP/RNBQKBNR b KQkq e3 0 1"++ it "should update en passant square for black correctly" $+ testApplyingMove "rnbqkbnr/pppppppp/8/8/4P3/8/PPPP1PPP/RNBQKBNR b KQkq e3 0 1" (PawnDoubleMove (Piece Black Pawn) (coord "c7") (coord "c5")) "rnbqkbnr/pp1ppppp/8/2p5/4P3/8/PPPP1PPP/RNBQKBNR w KQkq c6 0 2"++ it "should update halfmove counter when no capture of pawn advance" $+ testApplyingMove "rnbqkbnr/pp1ppppp/8/2p5/4P3/8/PPPP1PPP/RNBQKBNR w KQkq c6 0 2" (Movement (Piece White Knight) (coord "g1") (coord "f3")) "rnbqkbnr/pp1ppppp/8/2p5/4P3/5N2/PPPP1PPP/RNBQKB1R b KQkq - 1 2"++ it "should zero halfmove counter piece is captured" $+ testApplyingMove "r1bqkb1r/pppppppp/2n2n2/4N3/8/2N5/PPPPPPPP/R1BQKB1R b KQkq - 5 3" (Capture (Piece Black Knight) (coord "c6") (coord "e5")) "r1bqkb1r/pppppppp/5n2/4n3/8/2N5/PPPPPPPP/R1BQKB1R w KQkq - 0 4"++ it "should zero halfmove counter when pawn moves" $+ testApplyingMove "r1bqkb1r/pppp1ppp/2n2n2/4p3/2B1P3/2N2N2/PPPP1PPP/R1BQK2R b KQkq - 5 4" (Movement (Piece Black Pawn) (coord "d7") (coord "d6")) "r1bqkb1r/ppp2ppp/2np1n2/4p3/2B1P3/2N2N2/PPPP1PPP/R1BQK2R w KQkq - 0 5"++ it "should zero halfmove counter when pawn promotes" $+ testApplyingMove "rnbqkbnr/ppp2ppp/B7/4N3/8/2N5/PPPP2pP/R1BQK2R b KQkq - 1 6" (Promotion (Piece Black Pawn) (coord "g2") (coord "g1") Queen) "rnbqkbnr/ppp2ppp/B7/4N3/8/2N5/PPPP3P/R1BQK1qR w KQkq - 0 7"++ it "should zero halfmove counter when pawn promotes and captures" $+ testApplyingMove "rnbqkbnr/ppp2ppp/B7/4N3/8/2N5/PPPP2pP/R1BQK2R b KQkq - 1 6" (Promotion (Piece Black Pawn) (coord "g2") (coord "h1") Queen) "rnbqkbnr/ppp2ppp/B7/4N3/8/2N5/PPPP3P/R1BQK2q w Qkq - 0 7"++ it "should invalidate short castling when kingside rook moves" $+ testApplyingMove "rnbqk1nr/pppp2pp/5p2/2b5/2B1Pp2/5N2/PPPP2PP/RNBQK2R w KQkq - 0 5" (Movement (Piece White Rook) (coord "h1") (coord "g1")) "rnbqk1nr/pppp2pp/5p2/2b5/2B1Pp2/5N2/PPPP2PP/RNBQK1R1 b Qkq - 1 5"++ it "should invalidate long castling when queenside rook moves" $+ testApplyingMove "r3k1nr/pppq2pp/2npbp2/2b5/2B1PB2/2NP1N2/PPP1Q1PP/R3K1R1 b Qkq - 0 9" (Movement (Piece Black Rook) (coord "a8") (coord "d8")) "3rk1nr/pppq2pp/2npbp2/2b5/2B1PB2/2NP1N2/PPP1Q1PP/R3K1R1 w Qk - 1 10"++ it "should invalidate both castlings when king moves" $+ testApplyingMove "rnb1kbnr/ppppqppp/8/4p3/2B1P3/8/PPPP1PPP/RNBQK1NR w KQkq - 2 3" (Movement (Piece White King) (coord "e1") (coord "e2")) "rnb1kbnr/ppppqppp/8/4p3/2B1P3/8/PPPPKPPP/RNBQ2NR b kq - 3 3"++ it "should invalidate long castling when queenside rook is captured" $+ testApplyingMove "r1b1kbnr/1p1npppp/R2q4/p1pp4/P7/8/1PPPPPPP/1NBQKBNR w Kkq - 4 6" (Capture (Piece White Rook) (coord "a6") (coord "a8")) "R1b1kbnr/1p1npppp/3q4/p1pp4/P7/8/1PPPPPPP/1NBQKBNR b Kk - 0 6"++isCheckmateSpec :: Spec+isCheckmateSpec =+ describe "isCheckmate" $ do+ it "should not consider initial state as checkmate" $+ isCheckmate initialState `shouldBe` False++ it "should not consider check a checkmate" $+ isCheckmate (game "rnbqkb1r/ppp2ppp/3p1n2/1B2p3/4P3/2N2N2/PPPP1PPP/R1BQK2R b KQkq - 1 4") `shouldBe` False++ it "should not consider stalemates a checkmate" $ do+ isCheckmate (game "1R6/8/8/8/8/8/7R/k6K b - - 0 1") `shouldBe` False+ isCheckmate (game "8/8/5k2/p4p1p/P4K1P/1r6/8/8 w - - 0 2") `shouldBe` False++ it "should detect checkmate correctly" $ do+ isCheckmate (game "8/5r2/4K1q1/4p3/3k4/8/8/8 w - - 0 7") `shouldBe` True+ isCheckmate (game "4r2r/p6p/1pnN2p1/kQp5/3pPq2/3P4/PPP3PP/R5K1 b - - 0 2") `shouldBe` True+ isCheckmate (game "r3k2r/ppp2p1p/2n1p1p1/8/2B2P1q/2NPb1n1/PP4PP/R2Q3K w kq - 0 8") `shouldBe` True+ isCheckmate (game "8/6R1/pp1r3p/6p1/P3R1Pk/1P4P1/7K/8 b - - 0 4") `shouldBe` True++isStalemateSpec :: Spec+isStalemateSpec =+ describe "isStalemate" $ do+ it "should not consider initial state as stalemate" $+ isStalemate initialState `shouldBe` False++ it "should not consider check a stalemate" $+ isStalemate (game "rnbqkb1r/ppp2ppp/3p1n2/1B2p3/4P3/2N2N2/PPPP1PPP/R1BQK2R b KQkq - 1 4") `shouldBe` False++ it "should detect stalemate correctly" $ do+ isStalemate (game "1R6/8/8/8/8/8/7R/k6K b - - 0 1") `shouldBe` True+ isStalemate (game "8/8/5k2/p4p1p/P4K1P/1r6/8/8 w - - 0 2") `shouldBe` True++isInsufficientMaterialSpec :: Spec+isInsufficientMaterialSpec =+ describe "isInsufficientMaterial" $ do+ it "should not consider initial state as insufficient material" $+ isInsufficientMaterial initialState `shouldBe` False++ it "should not consider queen+king vs. queen+king as insufficient material" $+ isInsufficientMaterial (game "3qk3/8/8/8/8/8/8/3QK3 w - - 0 10") `shouldBe` False++ it "should not consider rook+king vs. king as insufficient material" $ do+ isInsufficientMaterial (game "4k3/8/8/8/8/8/8/3RK3 w - - 0 10") `shouldBe` False+ isInsufficientMaterial (game "4k3/2r5/8/8/8/8/8/4K3 w - - 0 1") `shouldBe` False++ it "should not consider pawn+king vs. king as insufficient material" $ do+ isInsufficientMaterial (game "4k3/8/8/8/8/8/1P6/4K3 w - - 0 10") `shouldBe` False+ isInsufficientMaterial (game "4k3/2p5/8/8/8/8/8/4K3 w - - 0 1") `shouldBe` False++ it "should not consider knight+bishop+king vs. king as insufficient material" $+ isInsufficientMaterial (game "4k3/8/8/8/8/8/2BN4/4K3 w - - 0 1") `shouldBe` False++ it "should not consider bishop+bishop+king vs. king as insufficient material if bishops are on different colored squares" $+ isInsufficientMaterial (game "4k3/8/8/8/8/8/2BB4/4K3 w - - 0 1") `shouldBe` False++ it "should consider bishop+bishop+king vs. king as insufficient material if bishops are on same colored squares" $+ isInsufficientMaterial (game "4k3/8/8/8/8/2B5/3B4/4K3 w - - 0 1") `shouldBe` True++ it "should not consider knight+knight+king vs. king as insufficient material" $+ isInsufficientMaterial (game "4k3/8/8/8/8/8/2NN4/4K3 w - - 0 1") `shouldBe` False++ it "should consider king vs. king as insufficient material" $+ isInsufficientMaterial (game "4k3/8/8/8/8/8/8/4K3 w - - 0 10") `shouldBe` True++ it "should consider bishop+king vs. king as insufficient material" $ do+ isInsufficientMaterial (game "4k3/8/8/8/8/8/8/3BK3 w - - 0 10") `shouldBe` True+ isInsufficientMaterial (game "4k3/2b5/8/8/8/8/8/4K3 w - - 0 1") `shouldBe` True++ it "should consider knight+king vs. king as insufficient material" $ do+ isInsufficientMaterial (game "4k3/8/8/8/8/8/8/3NK3 w - - 0 10") `shouldBe` True+ isInsufficientMaterial (game "4k3/2n5/8/8/8/8/8/4K3 w - - 0 1") `shouldBe` True++ it "should consider bishop+king vs. bishop+king as insufficient material if both bishops are on same color square" $+ isInsufficientMaterial (game "4k3/8/3b4/8/8/8/1B6/4K3 w - - 0 10") `shouldBe` True++ it "should consider n*bishop+king vs. n*bishop+king as insufficient material if bishop pairs are on same color square" $+ isInsufficientMaterial (game "8/b1B1b1B1/1b1B1b1B/8/8/8/8/1k5K w - - 0 1") `shouldBe` True++ it "should not consider n*bishop+king vs. n*bishop+king as insufficient material if bishop pairs are on different color square" $+ isInsufficientMaterial (game "8/bB2b1B1/1b1B1b1B/8/8/8/8/1k5K w - - 0 1") `shouldBe` False++ it "should not consider bishop+king vs. bishop+king as insufficient material if both bishops are on different color square" $+ isInsufficientMaterial (game "4k3/8/4b3/8/8/8/1B6/4K3 w - - 0 10") `shouldBe` False++isDrawSpec :: Spec+isDrawSpec =+ describe "isDraw" $ do+ it "should not detect normal game as draw" $+ isDraw initialState `shouldBe` False++ it "should not detect checkmate as draw" $+ isDraw (game "8/5r2/4K1q1/4p3/3k4/8/8/8 w - - 0 7") `shouldBe` False++ it "should detect stalemate as draw" $+ isDraw (game "1R6/8/8/8/8/8/7R/k6K b - - 0 1") `shouldBe` True++ it "should detect insufficient material as draw" $+ isDraw (game "4k3/8/8/8/8/8/8/4K3 w - - 0 10") `shouldBe` True++testApplyingMove :: String -> Move -> String -> Expectation+testApplyingMove beforeFen move afterFen = writeFEN newGame `shouldBe` afterFen+ where Right newGame = applyMove (game beforeFen) move++getWinnerSpec :: Spec+getWinnerSpec =+ describe "getWinner" $ do+ it "should not give winner if there is no checkmate" $+ getWinner (game "rnbqkb1r/ppp2ppp/3p1n2/1B2p3/4P3/2N2N2/PPPP1PPP/R1BQK2R b KQkq - 1 4") `shouldBe` Nothing++ it "should not give winner if the game is draw" $+ getWinner (game "1R6/8/8/8/8/8/7R/k6K b - - 0 1") `shouldBe` Nothing++ it "should return correct winner if the game is checkmate" $ do+ getWinner (game "8/5r2/4K1q1/4p3/3k4/8/8/8 w - - 0 7") `shouldBe` Just Black+ getWinner (game "4r2r/p6p/1pnN2p1/kQp5/3pPq2/3P4/PPP3PP/R5K1 b - - 0 2") `shouldBe` Just White
+ test/Chess/MoveTests.hs view
@@ -0,0 +1,339 @@+module MoveTests where++import Chess.Internal.Piece+import Chess.Internal.Board+import Chess.Internal.Move+import TestUtils+import Test.Hspec++moveSpec :: IO ()+moveSpec = hspec $+ describe "Move" $ do+ isCorrectStartPieceSpec+ isRightPlayerMoveSpec+ areCoordinatesValidSpec+ generateAllRookMovesSpec+ generateAllBishopMovesSpec+ generateAllQueenMovesSpec+ generateAllKnightMovesSpec+ generateAllKingMovesSpec+ generateAllPawnMovesSpec+ generateAllPotentialMovesSpec+ boardAfterMoveSpec+ generateAllMovesSpec++isCorrectStartPieceSpec :: Spec+isCorrectStartPieceSpec =+ describe "isCorrectStartPiece" $+ it "should detect whether the piece in the coordinates matches the given piece information" $ do+ isCorrectStartPiece initialBoard (Piece White Pawn) (coord "e2") `shouldBe` True+ isCorrectStartPiece initialBoard (Piece White Knight) (coord "b1") `shouldBe` True+ isCorrectStartPiece initialBoard (Piece Black Pawn) (coord "e2") `shouldBe` False+ isCorrectStartPiece initialBoard (Piece White Bishop) (coord "e2") `shouldBe` False+ isCorrectStartPiece initialBoard (Piece White Pawn) (coord "e3") `shouldBe` False++isRightPlayerMoveSpec :: Spec+isRightPlayerMoveSpec =+ describe "isRightPlayerMove" $+ it "should detect whether the movement is by given player" $ do+ isRightPlayerMove White (Movement (Piece White Pawn) (coord "e2") (coord "e3")) `shouldBe` True+ isRightPlayerMove White (Movement (Piece Black Pawn) (coord "e7") (coord "e6")) `shouldBe` False+ isRightPlayerMove Black (Capture (Piece Black Queen) (coord "a1") (coord "a2")) `shouldBe` True+ isRightPlayerMove Black (Capture (Piece White Queen) (coord "a1") (coord "a2")) `shouldBe` False+ isRightPlayerMove White (Castling White Short) `shouldBe` True+ isRightPlayerMove Black (Castling White Long) `shouldBe` False+ isRightPlayerMove White (EnPassant (Piece White Pawn) (coord "e2") (coord "d3")) `shouldBe` True+ isRightPlayerMove Black (EnPassant (Piece White Pawn) (coord "e2") (coord "d3")) `shouldBe` False+ isRightPlayerMove Black (Promotion (Piece Black Pawn) (coord "e2") (coord "e1") Queen) `shouldBe` True+ isRightPlayerMove White (Promotion (Piece Black Pawn) (coord "e2") (coord "e1") Queen) `shouldBe` False+ isRightPlayerMove White (PawnDoubleMove (Piece White Pawn) (coord "e2") (coord "e4")) `shouldBe` True+ isRightPlayerMove Black (PawnDoubleMove (Piece White Pawn) (coord "e2") (coord "e4")) `shouldBe` False++areCoordinatesValidSpec :: Spec+areCoordinatesValidSpec =+ describe "areCoordinatesValid" $ do+ it "should return Nothing if both coordinates are inside bounds" $ do+ areCoordinatesValid (0, 0) (1, 2) `shouldBe` Nothing+ areCoordinatesValid (4, 4) (0, 7) `shouldBe` Nothing++ it "should return InvalidCoordinates error if at least one coordinate is out of bounds" $ do+ areCoordinatesValid (3, 3) (3, 3) `shouldBe` Just InvalidCoordinates+ areCoordinatesValid (-1, 0) (3, 3) `shouldBe` Just InvalidCoordinates+ areCoordinatesValid (7, 0) (7, 8) `shouldBe` Just InvalidCoordinates++generateAllRookMovesSpec :: Spec+generateAllRookMovesSpec =+ describe "generateAllRookMoves" $ do+ it "should return all movement and capture moves for a rook in a square" $+ generateAllRookMoves (game "k4b1r/p7/7p/4P3/1n2P2R/8/P2B1P2/3K2N1 w - - 6 9") (coord "h4") `shouldMatchList`+ [ Movement (Piece White Rook) (coord "h4") (coord "h5")+ , Movement (Piece White Rook) (coord "h4") (coord "g4")+ , Movement (Piece White Rook) (coord "h4") (coord "f4")+ , Movement (Piece White Rook) (coord "h4") (coord "h3")+ , Movement (Piece White Rook) (coord "h4") (coord "h2")+ , Movement (Piece White Rook) (coord "h4") (coord "h1")+ , Capture (Piece White Rook) (coord "h4") (coord "h6")]++ it "should return empty list of moves if no move is possible" $+ generateAllRookMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (coord "a1") `shouldMatchList` []++generateAllBishopMovesSpec :: Spec+generateAllBishopMovesSpec =+ describe "generateAllBishopMoves" $ do+ it "should return all movement and capture moves for a bishop in a square" $+ generateAllBishopMoves (game "rnb1kbnr/pppp1ppp/8/5p2/8/3B4/PPPP3P/Rq1QKN2 w Qkq - 4 12") (coord "d3") `shouldMatchList`+ [ Movement (Piece White Bishop) (coord "d3") (coord "c4")+ , Movement (Piece White Bishop) (coord "d3") (coord "b5")+ , Movement (Piece White Bishop) (coord "d3") (coord "a6")+ , Movement (Piece White Bishop) (coord "d3") (coord "e4")+ , Movement (Piece White Bishop) (coord "d3") (coord "e2")+ , Capture (Piece White Bishop) (coord "d3") (coord "f5")]++ it "should return empty list of moves if no move is possible" $+ generateAllBishopMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (coord "c1") `shouldMatchList` []++generateAllQueenMovesSpec :: Spec+generateAllQueenMovesSpec =+ describe "generateAllQueenMoves" $ do+ it "should return all movement and capture moves for a queen in a square" $ do+ generateAllQueenMoves (game "rnb1kbnr/pppp1ppp/8/5p2/8/3B4/PPPP3P/Rq1QKN2 b Qkq - 4 12") (coord "b1") `shouldMatchList`+ [ Movement (Piece Black Queen) (coord "b1") (coord "c1")+ , Capture (Piece Black Queen) (coord "b1") (coord "a1")+ , Capture (Piece Black Queen) (coord "b1") (coord "a2")+ , Capture (Piece Black Queen) (coord "b1") (coord "b2")+ , Capture (Piece Black Queen) (coord "b1") (coord "c2")+ , Capture (Piece Black Queen) (coord "b1") (coord "d1")]+ generateAllQueenMoves (game "r2qkb1r/ppnp2pp/4pp1n/4b3/2Q2P2/1P2P3/1P2BPPP/RPB1K1NR w KQkq - 2 13") (coord "c4") `shouldMatchList`+ [ Movement (Piece White Queen) (coord "c4") (coord "b5")+ , Movement (Piece White Queen) (coord "c4") (coord "a6")+ , Movement (Piece White Queen) (coord "c4") (coord "d5")+ , Movement (Piece White Queen) (coord "c4") (coord "d3")+ , Movement (Piece White Queen) (coord "c4") (coord "b4")+ , Movement (Piece White Queen) (coord "c4") (coord "a4")+ , Movement (Piece White Queen) (coord "c4") (coord "c5")+ , Movement (Piece White Queen) (coord "c4") (coord "c6")+ , Movement (Piece White Queen) (coord "c4") (coord "d4")+ , Movement (Piece White Queen) (coord "c4") (coord "e4")+ , Movement (Piece White Queen) (coord "c4") (coord "c3")+ , Movement (Piece White Queen) (coord "c4") (coord "c2")+ , Capture (Piece White Queen) (coord "c4") (coord "c7")+ , Capture (Piece White Queen) (coord "c4") (coord "e6")]++ it "should return empty list of moves if no move is possible" $+ generateAllQueenMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (coord "d1") `shouldMatchList` []++generateAllKnightMovesSpec :: Spec+generateAllKnightMovesSpec =+ describe "generateAllKnightMoves" $+ it "should return all movement and capture moves for a knight in a square" $ do+ generateAllKnightMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (coord "b1") `shouldMatchList`+ [ Movement (Piece White Knight) (coord "b1") (coord "a3")+ , Movement (Piece White Knight) (coord "b1") (coord "c3")]+ generateAllKnightMoves (game "r2qkbnr/2p1pppp/ppp5/bn6/3P4/2P5/PP2PPPP/RNBQKBNR b - - 3 7") (coord "b5") `shouldMatchList`+ [ Movement (Piece Black Knight) (coord "b5") (coord "d6")+ , Movement (Piece Black Knight) (coord "b5") (coord "a7")+ , Movement (Piece Black Knight) (coord "b5") (coord "a3")+ , Capture (Piece Black Knight) (coord "b5") (coord "c3")+ , Capture (Piece Black Knight) (coord "b5") (coord "d4")]++generateAllKingMovesSpec :: Spec+generateAllKingMovesSpec =+ describe "generateAllKingMoves" $ do+ it "should return empty list of moves if no move is possible" $+ generateAllKingMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (coord "e1") `shouldMatchList` []++ it "should return all movement and capture moves for a king in a square" $+ generateAllKingMoves (game "2b5/pkp1prpp/8/rpn5/1K6/2P5/PP2N1PR/N1Q5 w - - 2 15") (coord "b4") `shouldMatchList`+ [ Movement (Piece White King) (coord "b4") (coord "a4")+ , Movement (Piece White King) (coord "b4") (coord "a3")+ , Movement (Piece White King) (coord "b4") (coord "b3")+ , Movement (Piece White King) (coord "b4") (coord "c4")+ , Capture (Piece White King) (coord "b4") (coord "a5")+ , Capture (Piece White King) (coord "b4") (coord "b5")+ , Capture (Piece White King) (coord "b4") (coord "c5")]++ it "should return castling moves when castling is possible" $+ generateAllKingMoves (game "1rq1kbr1/pppbnn1p/8/8/8/3N4/PPPP2PP/R3K2R w KQ - 0 10") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "e2")+ , Movement (Piece White King) (coord "e1") (coord "f2")+ , Movement (Piece White King) (coord "e1") (coord "f1")+ , Castling White Long+ , Castling White Short]++ it "should not return castling move if the castling has been invalidated" $ do+ generateAllKingMoves (game "r3k2r/ppppp1pp/2n2p2/3b4/8/2B2PPB/PPPPP2P/R3K2R w Qk - 5 14") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "f2")+ , Movement (Piece White King) (coord "e1") (coord "f1")+ , Castling White Long]+ generateAllKingMoves (game "r3k2r/ppppp1pp/2n2p2/3b4/8/2B2PPB/PPPPP2P/R3K2R w Qk - 5 14") (coord "e8") `shouldMatchList`+ [ Movement (Piece Black King) (coord "e8") (coord "d8")+ , Movement (Piece Black King) (coord "e8") (coord "f7")+ , Movement (Piece Black King) (coord "e8") (coord "f8")+ , Castling Black Short]++ it "should not return castling move if there is piece between castling line" $+ generateAllKingMoves (game "4k3/n7/8/8/8/5N2/P1N2PPP/R1n1K1R1 w Q - 0 16") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "d2")+ , Movement (Piece White King) (coord "e1") (coord "e2")+ , Movement (Piece White King) (coord "e1") (coord "f1")]++ it "should not return castling move if there is an opponent piece threatening castling end square" $+ generateAllKingMoves (game "3rk1r1/5p2/8/8/3b2N1/5P2/1PP1P1PP/4K2R w K - 2 20") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "d2")+ , Movement (Piece White King) (coord "e1") (coord "f1")+ , Movement (Piece White King) (coord "e1") (coord "f2")]++ it "should not return castling move if there is an opponent piece threatening a castling line square" $+ generateAllKingMoves (game "3rk3/5p2/5r2/8/3P2N1/8/1PP1P1PP/4K2R w K - 0 12") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "d2")+ , Movement (Piece White King) (coord "e1") (coord "f1")+ , Movement (Piece White King) (coord "e1") (coord "f2")]++ it "castling out of check should not be legal" $+ generateAllKingMoves (game "3rk3/5p2/4r3/8/3P2N1/8/1PP2PPP/4K2R w K - 0 12") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "d2")+ , Movement (Piece White King) (coord "e1") (coord "e2")+ , Movement (Piece White King) (coord "e1") (coord "f1")]++ it "castling when rook is threatened should be possible" $+ generateAllKingMoves (game "3rk3/5p2/7r/8/3P2N1/8/1PP2PP1/4K2R w K - 0 12") (coord "e1") `shouldMatchList`+ [ Movement (Piece White King) (coord "e1") (coord "d1")+ , Movement (Piece White King) (coord "e1") (coord "d2")+ , Movement (Piece White King) (coord "e1") (coord "e2")+ , Movement (Piece White King) (coord "e1") (coord "f1")+ , Castling White Short]++generateAllPawnMovesSpec :: Spec+generateAllPawnMovesSpec =+ describe "generateAllPawnMoves" $ do+ it "should return both normal movement and double move when possible" $ do+ generateAllPawnMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (coord "e2") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "e2") (coord "e3")+ , PawnDoubleMove (Piece White Pawn) (coord "e2") (coord "e4")]+ generateAllPawnMoves (game "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR b KQkq - 0 1") (coord "a7") `shouldMatchList`+ [ Movement (Piece Black Pawn) (coord "a7") (coord "a6")+ , PawnDoubleMove (Piece Black Pawn) (coord "a7") (coord "a5")]++ it "should return empty list when no moves are possible" $ do+ generateAllPawnMoves (game "rnbqkbnr/pppp1ppp/8/4p3/4P3/8/PPP2PPP/RNBQKBNR w KQkq - 0 1") (coord "e4") `shouldMatchList` []+ generateAllPawnMoves (game "rnbqkbnr/pppp1ppp/8/4p3/4P3/8/PPP2PPP/RNBQKBNR b KQkq - 0 1") (coord "e5") `shouldMatchList` []++ it "should return both movement and capture moves when possible" $+ generateAllPawnMoves (game "rnbqkbnr/pppp1ppp/8/4p3/4PP2/8/PPP5/RNBQKBNR w KQkq - 0 1") (coord "f4") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "f4") (coord "f5")+ , Capture (Piece White Pawn) (coord "f4") (coord "e5")]++ it "should return only capture when normal movement is not possible" $+ generateAllPawnMoves (game "rnbqkbnr/pppp1ppp/8/4p3/4PP2/8/PPP5/RNBQKBNR w KQkq - 0 1") (coord "e5") `shouldMatchList`+ [ Capture (Piece Black Pawn) (coord "e5") (coord "f4")]++ it "should return normal movement when capture is not possible" $+ generateAllPawnMoves (game "rnbqkbnr/pppp1p1p/8/4pPp1/4P3/8/PPPP2PP/RNBQKBNR w KQkq - 0 4") (coord "f5") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "f5") (coord "f6")]++ it "should return en passant when it is possible" $ do+ generateAllPawnMoves (game "rnbqkbnr/ppp1p1pp/8/3pPp2/8/8/PPPP1PPP/RNBQKBNR w KQkq f6 0 3") (coord "e5") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "e5") (coord "e6")+ , EnPassant (Piece White Pawn) (coord "e5") (coord "f6")]+ generateAllPawnMoves (game "rnbqkbnr/ppp1pppp/8/8/2PpPP2/8/PP1P2PP/RNBQKBNR b KQkq c3 0 3") (coord "d4") `shouldMatchList`+ [ Movement (Piece Black Pawn) (coord "d4") (coord "d3")+ , EnPassant (Piece Black Pawn) (coord "d4") (coord "c3")]++ it "should not return en passant when en passant square is not one of the capture squares" $+ generateAllPawnMoves (game "rnbqkbnr/1pppp3/p5pp/3PPp2/8/8/PPP2PPP/RNBQKBNR w KQkq f6 0 5") (coord "d5") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "d5") (coord "d6")]++ it "should return all promotion moves when promotion with normal movement or by capture is possible" $ do+ generateAllPawnMoves (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") (coord "c7") `shouldMatchList`+ [ Promotion (Piece White Pawn) (coord "c7") (coord "c8") Rook+ , Promotion (Piece White Pawn) (coord "c7") (coord "c8") Knight+ , Promotion (Piece White Pawn) (coord "c7") (coord "c8") Bishop+ , Promotion (Piece White Pawn) (coord "c7") (coord "c8") Queen+ , Promotion (Piece White Pawn) (coord "c7") (coord "b8") Rook+ , Promotion (Piece White Pawn) (coord "c7") (coord "b8") Knight+ , Promotion (Piece White Pawn) (coord "c7") (coord "b8") Bishop+ , Promotion (Piece White Pawn) (coord "c7") (coord "b8") Queen]+ generateAllPawnMoves (game "k7/8/8/8/8/8/p7/1N2K3 w - - 0 1") (coord "a2") `shouldMatchList`+ [ Promotion (Piece Black Pawn) (coord "a2") (coord "a1") Rook+ , Promotion (Piece Black Pawn) (coord "a2") (coord "a1") Knight+ , Promotion (Piece Black Pawn) (coord "a2") (coord "a1") Bishop+ , Promotion (Piece Black Pawn) (coord "a2") (coord "a1") Queen+ , Promotion (Piece Black Pawn) (coord "a2") (coord "b1") Rook+ , Promotion (Piece Black Pawn) (coord "a2") (coord "b1") Knight+ , Promotion (Piece Black Pawn) (coord "a2") (coord "b1") Bishop+ , Promotion (Piece Black Pawn) (coord "a2") (coord "b1") Queen]++ it "should not return any moves if no move is possible" $ do+ generateAllPawnMoves (game "k7/8/8/8/8/8/p7/N3K3 w - - 0 1") (coord "a2") `shouldMatchList` []+ generateAllPawnMoves (game "k7/8/8/8/8/4b3/4P3/K7 w - - 0 1") (coord "e2") `shouldMatchList` []++ it "should generate normal movement correctly" $+ generateAllPawnMoves (game "6k1/8/8/8/8/3P4/8/4K3 w - - 0 1") (coord "d3") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "d3") (coord "d4")]++generateAllPotentialMovesSpec :: Spec+generateAllPotentialMovesSpec =+ describe "generateAllPotentialMoves" $+ it "should return all potential moves for all pieces of the current player" $ do+ generateAllPotentialMoves (game "8/k7/8/8/6p1/7P/6PK/8 w - - 0 1") `shouldMatchList`+ [ Movement (Piece White Pawn) (coord "g2") (coord "g3")+ , Movement (Piece White Pawn) (coord "h3") (coord "h4")+ , Capture (Piece White Pawn) (coord "h3") (coord "g4")+ , Movement (Piece White King) (coord "h2") (coord "g3")+ , Movement (Piece White King) (coord "h2") (coord "h1")+ , Movement (Piece White King) (coord "h2") (coord "g1")]+ generateAllPotentialMoves (game "8/k7/8/8/6p1/7P/6PK/8 b - - 0 1") `shouldMatchList`+ [ Capture (Piece Black Pawn) (coord "g4") (coord "h3")+ , Movement (Piece Black Pawn) (coord "g4") (coord "g3")+ , Movement (Piece Black King) (coord "a7") (coord "a8")+ , Movement (Piece Black King) (coord "a7") (coord "a6")+ , Movement (Piece Black King) (coord "a7") (coord "b8")+ , Movement (Piece Black King) (coord "a7") (coord "b7")+ , Movement (Piece Black King) (coord "a7") (coord "b6")]++boardAfterMoveSpec :: Spec+boardAfterMoveSpec =+ describe "boardAfterMove" $ do+ it "should make pawn double move correctly" $ do+ boardAfterMove (fenBoard "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1") (PawnDoubleMove (Piece White Pawn) (coord "e2") (coord "e4")) `shouldBe` Just (fenBoard "rnbqkbnr/pppppppp/8/8/4P3/8/PPPP1PPP/RNBQKBNR w KQkq - 0 1")+ boardAfterMove (fenBoard "rnbqkbnr/p1pp1ppp/p7/4p3/4P3/5N2/PPPP1PPP/RNBQ1RK1 b kq - 1 1") (PawnDoubleMove (Piece Black Pawn) (coord "c7") (coord "c5")) `shouldBe` Just (fenBoard "rnbqkbnr/p2p1ppp/p7/2p1p3/4P3/5N2/PPPP1PPP/RNBQ1RK1 w kq c6 0 2")+ boardAfterMove (fenBoard "rnbqkbnr/p2p1ppp/p7/4N3/2p1P3/8/PPPP1PPP/RNBQ1RK1 w kq - 0 3") (PawnDoubleMove (Piece White Pawn) (coord "d2") (coord "d4")) `shouldBe` Just (fenBoard "rnbqkbnr/p2p1ppp/p7/4N3/2pPP3/8/PPP2PPP/RNBQ1RK1 b kq d3 0 3")++ it "should make pawn normal move correctly" $ do+ boardAfterMove (fenBoard "rnbqkbnr/pppp1ppp/8/4p3/4P3/8/PPPP1PPP/RNBQKBNR w KQkq - 0 1") (Movement (Piece White Knight) (coord "g1") (coord "f3")) `shouldBe` Just (fenBoard "rnbqkbnr/pppp1ppp/8/4p3/4P3/5N2/PPPP1PPP/RNBQKB1R w KQkq - 0 1")+ boardAfterMove (fenBoard "rnbqkbnr/p2p1ppp/p7/2p1N3/4P3/8/PPPP1PPP/RNBQ1RK1 b kq - 0 2") (Movement (Piece Black Pawn) (coord "c5") (coord "c4")) `shouldBe` Just (fenBoard "rnbqkbnr/p2p1ppp/p7/4N3/2p1P3/8/PPPP1PPP/RNBQ1RK1 w kq - 0 3")++ it "should make pawn capture move correctly" $+ boardAfterMove (fenBoard "rnbqkbnr/pppp1ppp/B7/4p3/4P3/5N2/PPPP1PPP/RNBQK2R w KQkq - 0 1") (Capture (Piece Black Pawn) (coord "b7") (coord "a6")) `shouldBe` Just (fenBoard "rnbqkbnr/p1pp1ppp/p7/4p3/4P3/5N2/PPPP1PPP/RNBQK2R w KQkq - 0 1")++ it "should move king and rook correctly in castling move" $+ boardAfterMove (fenBoard "rnbqkbnr/p1pp1ppp/p7/4p3/4P3/5N2/PPPP1PPP/RNBQK2R w KQkq - 0 1") (Castling White Short) `shouldBe` Just (fenBoard "rnbqkbnr/p1pp1ppp/p7/4p3/4P3/5N2/PPPP1PPP/RNBQ1RK1 b kq - 1 1")++ it "should make knight's capture move correctly" $+ boardAfterMove (fenBoard "rnbqkbnr/p2p1ppp/p7/2p1p3/4P3/5N2/PPPP1PPP/RNBQ1RK1 w kq c6 0 2") (Capture (Piece White Knight) (coord "f3") (coord "e5")) `shouldBe` Just (fenBoard "rnbqkbnr/p2p1ppp/p7/2p1N3/4P3/8/PPPP1PPP/RNBQ1RK1 b kq - 0 2")++ it "should make en passant move correctly" $+ boardAfterMove (fenBoard "rnbqkbnr/p2p1ppp/p7/4N3/2pPP3/8/PPP2PPP/RNBQ1RK1 b kq d3 0 3") (EnPassant (Piece Black Pawn) (coord "c4") (coord "d3")) `shouldBe` Just (fenBoard "rnbqkbnr/p2p1ppp/p7/4N3/4P3/3p4/PPP2PPP/RNBQ1RK1 w kq - 0 4")++generateAllMovesSpec :: Spec+generateAllMovesSpec =+ describe "generateAllMoves" $ do+ it "should generate all legal moves for the current player in a given game state" $+ generateAllMoves (game "rnbqkb1r/pp1p1Bpp/5n2/2p1p3/4P3/2P5/PP1P1PPP/RNBQK1NR b KQkq - 0 4") `shouldMatchList`+ [Movement (Piece Black King) (0,4) (1,4), Capture (Piece Black King) (0,4) (1,5)]++ it "should not give any legal moves in checkmate" $ do+ generateAllMoves (game "8/5r2/4K1q1/4p3/3k4/8/8/8 w - - 0 7") `shouldBe` []+ generateAllMoves (game "4r2r/p6p/1pnN2p1/kQp5/3pPq2/3P4/PPP3PP/R5K1 b - - 0 2") `shouldBe` []+ generateAllMoves (game "r3k2r/ppp2p1p/2n1p1p1/8/2B2P1q/2NPb1n1/PP4PP/R2Q3K w kq - 0 8") `shouldBe` []+ generateAllMoves (game "8/6R1/pp1r3p/6p1/P3R1Pk/1P4P1/7K/8 b - - 0 4") `shouldBe` []++ it "should not give any legal moves in stalemate" $ do+ generateAllMoves (game "1R6/8/8/8/8/8/7R/k6K b - - 0 1") `shouldBe` []+ generateAllMoves (game "8/8/5k2/p4p1p/P4K1P/1r6/8/8 w - - 0 2") `shouldBe` []
+ test/Chess/NotationTests.hs view
@@ -0,0 +1,64 @@+module NotationTests where++import Chess.Internal.Piece+import Chess.Internal.Move+import Chess.Internal.Notation+import TestUtils+import Test.Hspec++notationSpec :: IO ()+notationSpec = hspec $+ describe "Notation" parseCoordinateNotationSpec++parseCoordinateNotationSpec :: Spec+parseCoordinateNotationSpec =+ describe "parseCoordinateNotation" $ do+ it "should not parse invalid input" $ do+ parseCoordinateNotation initialState "" `shouldBe` Nothing+ parseCoordinateNotation initialState "e" `shouldBe` Nothing+ parseCoordinateNotation initialState "e2" `shouldBe` Nothing+ parseCoordinateNotation initialState "e2-" `shouldBe` Nothing+ parseCoordinateNotation initialState "e2-e" `shouldBe` Nothing+ parseCoordinateNotation initialState "e2-4" `shouldBe` Nothing+ parseCoordinateNotation initialState "fooba" `shouldBe` Nothing+ parseCoordinateNotation initialState "i2-i4" `shouldBe` Nothing+ parseCoordinateNotation initialState "12-34" `shouldBe` Nothing++ it "should not parse illegal moves" $ do+ parseCoordinateNotation initialState "b1-d2" `shouldBe` Nothing+ parseCoordinateNotation initialState "e7-e5" `shouldBe` Nothing++ it "should not parse moves with extra input" $ do+ parseCoordinateNotation initialState "e2-e4foo" `shouldBe` Nothing+ parseCoordinateNotation initialState "e2-e4=Qfoo" `shouldBe` Nothing++ it "should parse correctly pawn moves" $ do+ parseCoordinateNotation initialState "e2-e4" `shouldBe` Just (PawnDoubleMove (Piece White Pawn) (coord "e2") (coord "e4"))+ parseCoordinateNotation initialState "D2-D3" `shouldBe` Just (Movement (Piece White Pawn) (coord "d2") (coord "d3"))+ parseCoordinateNotation initialState "H2-H4" `shouldBe` Just (PawnDoubleMove (Piece White Pawn) (coord "h2") (coord "h4"))+ parseCoordinateNotation (game "r1bqkbnr/pppp1ppp/2n5/4p3/3PP3/5N2/PPP2PPP/RNBQKB1R b KQkq d3 0 3") "e5-d4" `shouldBe` Just (Capture (Piece Black Pawn) (coord "e5") (coord "d4"))++ it "should parse correctly knight moves" $+ parseCoordinateNotation initialState "b1-c3" `shouldBe` Just (Movement (Piece White Knight) (coord "b1") (coord "c3"))++ it "should parse correctly castling moves" $ do+ parseCoordinateNotation (game "r1b1k2r/pppq1ppp/2np1n2/2b1p3/2BPPB2/2N2N2/PPP2PPP/R2QK2R w KQkq - 4 7") "e1-g1" `shouldBe` Just (Castling White Short)+ parseCoordinateNotation (game "r1b1k2r/p1pq1ppp/1pnp1n2/2b1p3/2BPPB2/2N2N2/PPPQ1PPP/R3K2R w KQkq - 0 8") "e1-c1" `shouldBe` Just (Castling White Long)++ it "should parse correctly pawn promotion moves" $ do+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=N" `shouldBe` Just (Promotion (Piece White Pawn) (coord "c7") (coord "c8") Knight)+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=Q" `shouldBe` Just (Promotion (Piece White Pawn) (coord "c7") (coord "c8") Queen)+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-b8=Q" `shouldBe` Just (Promotion (Piece White Pawn) (coord "c7") (coord "b8") Queen)+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8(N)" `shouldBe` Just (Promotion (Piece White Pawn) (coord "c7") (coord "c8") Knight)+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8(Q)" `shouldBe` Just (Promotion (Piece White Pawn) (coord "c7") (coord "c8") Queen)+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8(Q" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8Q" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8(Q))" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8" `shouldBe` Nothing++ it "should not parse pawn promotion moves with illegal promotion piece" $ do+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=A" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=n" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=K" `shouldBe` Nothing+ parseCoordinateNotation (game "1r5k/2P5/8/8/8/8/8/4K2N w - - 0 1") "c7-c8=P" `shouldBe` Nothing
+ test/Chess/PieceTests.hs view
@@ -0,0 +1,43 @@+module PieceTests where++import Chess.Internal.Piece+import Test.Hspec++pieceSpec :: IO ()+pieceSpec = hspec $+ describe "Piece" $ do+ printPieceSpec+ parsePieceSpec++printPieceSpec :: Spec+printPieceSpec =+ describe "printPiece" $ do+ it "should print white player pieces uppercase" $ do+ printPiece (Piece White King) `shouldBe` "K"+ printPiece (Piece White Rook) `shouldBe` "R"+ printPiece (Piece White Knight) `shouldBe` "N"++ it "should print black player pieces lowercase" $ do+ printPiece (Piece Black Queen) `shouldBe` "q"+ printPiece (Piece Black Pawn) `shouldBe` "p"+ printPiece (Piece Black Bishop) `shouldBe` "b"++parsePieceSpec :: Spec+parsePieceSpec =+ describe "parsePiece" $ do+ it "should parse legal piecetypes correctly" $ do+ parsePiece 'k' `shouldBe` Just (Piece Black King)+ parsePiece 'Q' `shouldBe` Just (Piece White Queen)+ parsePiece 'P' `shouldBe` Just (Piece White Pawn)+ parsePiece 'r' `shouldBe` Just (Piece Black Rook)+ parsePiece 'R' `shouldBe` Just (Piece White Rook)+ parsePiece 'B' `shouldBe` Just (Piece White Bishop)+ parsePiece 'n' `shouldBe` Just (Piece Black Knight)++ it "should not parse invalid piecetypes" $ do+ parsePiece 'a' `shouldBe` Nothing+ parsePiece 'c' `shouldBe` Nothing+ parsePiece 'd' `shouldBe` Nothing+ parsePiece '0' `shouldBe` Nothing+ parsePiece '5' `shouldBe` Nothing+ parsePiece '!' `shouldBe` Nothing
+ test/Chess/TestUtils.hs view
@@ -0,0 +1,15 @@+module TestUtils (coord, game, fenBoard) where++import Chess.Internal.Board+import Chess.Internal.Move+import Chess.FEN+import Data.Maybe++coord :: String -> Coordinates+coord = fromJust . parseCoordinate++game :: String -> GameState+game = fromJust . readFEN++fenBoard :: String -> Board+fenBoard = stateBoard . fromJust . readFEN
+ test/Chess/UITests.hs view
@@ -0,0 +1,39 @@+module UITests where++import Chess+import Chess.UI+import Chess.Internal.Move+import Test.Hspec++uiSpec :: IO ()+uiSpec = hspec $+ describe "UI" $ do+ printBoardSpec+ printMoveSpec++printBoardSpec :: Spec+printBoardSpec =+ describe "printBoard" $ do+ it "should print the initial board correctly" $+ printBoard (board newGame) `shouldBe` newGamePrint++newGamePrint :: String+newGamePrint = " +---+---+---+---+---+---+---+---+\n8 | r | n | b | q | k | b | n | r |\n +---+---+---+---+---+---+---+---+\n7 | p | p | p | p | p | p | p | p |\n +---+---+---+---+---+---+---+---+\n6 | | | | | | | | |\n +---+---+---+---+---+---+---+---+\n5 | | | | | | | | |\n +---+---+---+---+---+---+---+---+\n4 | | | | | | | | |\n +---+---+---+---+---+---+---+---+\n3 | | | | | | | | |\n +---+---+---+---+---+---+---+---+\n2 | P | P | P | P | P | P | P | P |\n +---+---+---+---+---+---+---+---+\n1 | R | N | B | Q | K | B | N | R |\n +---+---+---+---+---+---+---+---+\n a b c d e f g h\n"++printMoveSpec :: Spec+printMoveSpec =+ describe "printMove" $ do+ it "should print normal moves correctly" $ do+ coordinateNotation (Movement (Piece White Pawn) (6, 4) (5, 4)) `shouldBe` "e2-e3"+ coordinateNotation (Capture (Piece White Pawn) (6, 4) (5, 5)) `shouldBe` "e2-f3"+ coordinateNotation (Capture (Piece Black Knight) (0, 1) (2, 2)) `shouldBe` "b8-c6"+ coordinateNotation (Castling White Short) `shouldBe` "e1-g1"+ coordinateNotation (Castling White Long) `shouldBe` "e1-c1"+ coordinateNotation (Castling Black Short) `shouldBe` "e8-g8"+ coordinateNotation (Castling Black Long) `shouldBe` "e8-c8"+ coordinateNotation (EnPassant (Piece White Pawn) (3, 4) (2, 5)) `shouldBe` "e5-f6"+ coordinateNotation (PawnDoubleMove (Piece White Pawn) (6, 1) (4, 1)) `shouldBe` "b2-b4"++ it "should print promotion moves correctly" $ do+ coordinateNotation (Promotion (Piece White Pawn) (1, 0) (0, 0) Queen) `shouldBe` "a7-a8q"+ coordinateNotation (Promotion (Piece Black Pawn) (6, 1) (7, 2) Knight) `shouldBe` "b2-c1n"
test/Spec.hs view
@@ -1,10 +1,10 @@-import Test.Hspec import GameTests import NotationTests import BoardTests import FENTests import MoveTests import PieceTests+import UITests main :: IO () main = do gameSpec@@ -13,3 +13,4 @@ fenSpec moveSpec pieceSpec+ uiSpec