module Chess.Internal.Game (applyMove, isCheckmate, isStalemate, isInsufficientMaterial, isDraw, getWinner) where import Data.List import Chess.Internal.Piece import Chess.Internal.Move import Chess.Internal.Board import Data.Maybe applyMove :: GameState -> Move -> Either MoveError GameState applyMove :: GameState -> Move -> Either MoveError GameState applyMove GameState game Move move = case Maybe MoveError moveError of Just MoveError mError -> MoveError -> Either MoveError GameState forall a b. a -> Either a b Left MoveError mError Maybe MoveError Nothing -> GameState -> Either MoveError GameState forall a b. b -> Either a b Right GameState newGame where moveError :: Maybe MoveError moveError = GameState -> Move -> Maybe MoveError isMoveError GameState game Move move newGame :: GameState newGame = Board -> Color -> [CastlingType] -> [CastlingType] -> Maybe Coordinates -> Integer -> Integer -> GameState State (GameState -> Move -> Board updateBoard GameState game Move move) (GameState -> Color updatePlayer GameState game) (GameState -> Move -> [CastlingType] updateWhiteCastlings GameState game Move move) (GameState -> Move -> [CastlingType] updateBlackCastlings GameState game Move move) (Move -> Maybe Coordinates updateEnPassantSquare Move move) (GameState -> Move -> Integer updateHalfMoveClock GameState game Move move) (GameState -> Integer updateMoveNumber GameState game) updateBoard :: GameState -> Move -> Board updateBoard :: GameState -> Move -> Board updateBoard GameState game Move move = Maybe Board -> Board forall a. HasCallStack => Maybe a -> a fromJust (Maybe Board -> Board) -> Maybe Board -> Board forall a b. (a -> b) -> a -> b $ Board -> Move -> Maybe Board boardAfterMove (GameState -> Board stateBoard GameState game) Move move updatePlayer :: GameState -> Color updatePlayer :: GameState -> Color updatePlayer GameState game = Color -> Color opponent (GameState -> Color currentPlayer GameState game) updateWhiteCastlings :: GameState -> Move -> [CastlingType] updateWhiteCastlings :: GameState -> Move -> [CastlingType] updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Movement (Piece Color White PieceType Rook) (Int 7, Int 0) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Movement (Piece Color White PieceType Rook) (Int 7, Int 7) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color White PieceType Rook) (Int 7, Int 0) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color White PieceType Rook) (Int 7, Int 7) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color Black PieceType _) Coordinates _ (Int 7, Int 0)) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color Black PieceType _) Coordinates _ (Int 7, Int 7)) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Promotion (Piece Color Black PieceType _) Coordinates _ (Int 7, Int 0) PieceType _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Promotion (Piece Color Black PieceType _) Coordinates _ (Int 7, Int 7) PieceType _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateWhiteCastlings (State Board _ Color _ [CastlingType] castlings [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) Move move = Color -> [CastlingType] -> Move -> [CastlingType] updateCastlings Color White [CastlingType] castlings Move move updateBlackCastlings :: GameState -> Move -> [CastlingType] updateBlackCastlings :: GameState -> Move -> [CastlingType] updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Movement (Piece Color Black PieceType Rook) (Int 0, Int 0) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Movement (Piece Color Black PieceType Rook) (Int 0, Int 7) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color Black PieceType Rook) (Int 0, Int 0) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color Black PieceType Rook) (Int 0, Int 7) Coordinates _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color White PieceType _) Coordinates _ (Int 0, Int 0)) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Capture (Piece Color White PieceType _) Coordinates _ (Int 0, Int 7)) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Promotion (Piece Color White PieceType _) Coordinates _ (Int 0, Int 0) PieceType _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Long [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) (Promotion (Piece Color White PieceType _) Coordinates _ (Int 0, Int 7) PieceType _) = CastlingType -> [CastlingType] -> [CastlingType] forall a. Eq a => a -> [a] -> [a] delete CastlingType Short [CastlingType] castlings updateBlackCastlings (State Board _ Color _ [CastlingType] _ [CastlingType] castlings Maybe Coordinates _ Integer _ Integer _) Move move = Color -> [CastlingType] -> Move -> [CastlingType] updateCastlings Color Black [CastlingType] castlings Move move updateCastlings :: Color -> [CastlingType] -> Move -> [CastlingType] updateCastlings :: Color -> [CastlingType] -> Move -> [CastlingType] updateCastlings Color player [CastlingType] _ (Castling Color movePlayer CastlingType _) | Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color movePlayer = [] updateCastlings Color player [CastlingType] _ (Movement (Piece Color movePlayer PieceType King) Coordinates _ Coordinates _) | Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color movePlayer = [] updateCastlings Color player [CastlingType] _ (Capture (Piece Color movePlayer PieceType King) Coordinates _ Coordinates _) | Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color movePlayer = [] updateCastlings Color _ [CastlingType] castlings Move _ = [CastlingType] castlings updateEnPassantSquare :: Move -> Maybe Coordinates updateEnPassantSquare :: Move -> Maybe Coordinates updateEnPassantSquare (PawnDoubleMove (Piece Color White PieceType Pawn) Coordinates _ (Int row, Int col)) = Coordinates -> Maybe Coordinates forall a. a -> Maybe a Just (Int row Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1, Int col) updateEnPassantSquare (PawnDoubleMove (Piece Color Black PieceType Pawn) Coordinates _ (Int row, Int col)) = Coordinates -> Maybe Coordinates forall a. a -> Maybe a Just (Int row Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1, Int col) updateEnPassantSquare Move _ = Maybe Coordinates forall a. Maybe a Nothing updateHalfMoveClock :: GameState -> Move -> Integer updateHalfMoveClock :: GameState -> Move -> Integer updateHalfMoveClock GameState _ Capture{} = Integer 0 updateHalfMoveClock GameState _ (Movement (Piece Color _ PieceType Pawn) Coordinates _ Coordinates _) = Integer 0 updateHalfMoveClock GameState _ (PawnDoubleMove (Piece Color _ PieceType Pawn) Coordinates _ Coordinates _) = Integer 0 updateHalfMoveClock GameState _ (Promotion (Piece Color _ PieceType Pawn) Coordinates _ Coordinates _ PieceType _) = Integer 0 updateHalfMoveClock (State Board _ Color _ [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer number Integer _) Move _ = Integer number Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer 1 updateMoveNumber :: GameState -> Integer updateMoveNumber :: GameState -> Integer updateMoveNumber (State Board _ Color White [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer number) = Integer number updateMoveNumber (State Board _ Color Black [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer number) = Integer number Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer 1 isCheckmate :: GameState -> Bool isCheckmate :: GameState -> Bool isCheckmate game :: GameState game@(State Board board Color player [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) = [Move] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (GameState -> [Move] generateAllMoves GameState game) Bool -> Bool -> Bool && Board -> Color -> Bool isCheck Board board Color player isStalemate :: GameState -> Bool isStalemate :: GameState -> Bool isStalemate game :: GameState game@(State Board board Color player [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) = [Move] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (GameState -> [Move] generateAllMoves GameState game) Bool -> Bool -> Bool && Bool -> Bool not (Board -> Color -> Bool isCheck Board board Color player) isInsufficientMaterial :: GameState -> Bool isInsufficientMaterial :: GameState -> Bool isInsufficientMaterial GameState game = [PieceType] -> [PieceType] -> Bool isInsufficientMaterialByPieces [PieceType] whitePieces [PieceType] blackPieces Bool -> Bool -> Bool || Board -> [PieceType] -> [PieceType] -> Bool isInsufficientMaterialWithBishops Board board [PieceType] whitePieces [PieceType] blackPieces where board :: Board board = GameState -> Board stateBoard GameState game whitePieces :: [PieceType] whitePieces = PieceType -> [PieceType] -> [PieceType] forall a. Eq a => a -> [a] -> [a] delete PieceType King ([PieceType] -> [PieceType]) -> [PieceType] -> [PieceType] forall a b. (a -> b) -> a -> b $ Board -> Color -> [PieceType] getPlayerPieces Board board Color White blackPieces :: [PieceType] blackPieces = PieceType -> [PieceType] -> [PieceType] forall a. Eq a => a -> [a] -> [a] delete PieceType King ([PieceType] -> [PieceType]) -> [PieceType] -> [PieceType] forall a b. (a -> b) -> a -> b $ Board -> Color -> [PieceType] getPlayerPieces Board board Color Black isInsufficientMaterialByPieces :: [PieceType] -> [PieceType] -> Bool isInsufficientMaterialByPieces :: [PieceType] -> [PieceType] -> Bool isInsufficientMaterialByPieces [] [] = Bool True isInsufficientMaterialByPieces [PieceType Bishop] [] = Bool True isInsufficientMaterialByPieces [PieceType Knight] [] = Bool True isInsufficientMaterialByPieces [] [PieceType Bishop] = Bool True isInsufficientMaterialByPieces [] [PieceType Knight] = Bool True isInsufficientMaterialByPieces [PieceType] _ [PieceType] _ = Bool False isInsufficientMaterialWithBishops :: Board -> [PieceType] -> [PieceType] -> Bool isInsufficientMaterialWithBishops :: Board -> [PieceType] -> [PieceType] -> Bool isInsufficientMaterialWithBishops Board _ [PieceType] white [PieceType] black | Bool -> Bool not ([PieceType] -> Bool forall (t :: * -> *). Foldable t => t PieceType -> Bool onlyBishops [PieceType] white Bool -> Bool -> Bool && [PieceType] -> Bool forall (t :: * -> *). Foldable t => t PieceType -> Bool onlyBishops [PieceType] black) = Bool False where onlyBishops :: t PieceType -> Bool onlyBishops t PieceType pieces = Bool -> Bool not ((PieceType -> Bool) -> t PieceType -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (PieceType -> PieceType -> Bool forall a. Eq a => a -> a -> Bool /= PieceType Bishop) t PieceType pieces) isInsufficientMaterialWithBishops Board board [PieceType] _ [PieceType] _ = Bool bishopsOnWhite Bool -> Bool -> Bool forall a. Eq a => a -> a -> Bool /= Bool bishopsOnBlack where whiteSquaresWithBishops :: [Coordinates] whiteSquaresWithBishops = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter (\Coordinates x -> Coordinates -> Color getSquareColor Coordinates x Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color White) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> a -> b $ Board -> PieceType -> [Coordinates] getSquaresWithPieces Board board PieceType Bishop blackSquaresWithBishops :: [Coordinates] blackSquaresWithBishops = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter (\Coordinates x -> Coordinates -> Color getSquareColor Coordinates x Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color Black) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> a -> b $ Board -> PieceType -> [Coordinates] getSquaresWithPieces Board board PieceType Bishop bishopsOnWhite :: Bool bishopsOnWhite = Bool -> Bool not ([Coordinates] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Coordinates] whiteSquaresWithBishops) bishopsOnBlack :: Bool bishopsOnBlack = Bool -> Bool not ([Coordinates] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Coordinates] blackSquaresWithBishops) isDraw :: GameState -> Bool isDraw :: GameState -> Bool isDraw GameState game = GameState -> Bool isStalemate GameState game Bool -> Bool -> Bool || GameState -> Bool isInsufficientMaterial GameState game getWinner :: GameState -> Maybe Color getWinner :: GameState -> Maybe Color getWinner GameState game | GameState -> Bool isCheckmate GameState game = Color -> Maybe Color forall a. a -> Maybe a Just (Color -> Maybe Color) -> Color -> Maybe Color forall a b. (a -> b) -> a -> b $ Color -> Color opponent (Color -> Color) -> Color -> Color forall a b. (a -> b) -> a -> b $ GameState -> Color currentPlayer GameState game | Bool otherwise = Maybe Color forall a. Maybe a Nothing