module Chess.Internal.Move (GameState(..), Move(..), CastlingType(..), MoveError(..), isRightPlayerMove, isMoveError, initialState, isCorrectStartPiece, areCoordinatesValid, generateAllRookMoves, iterateMovementSquares, iterateDirection, generateAllBishopMoves, generateAllQueenMoves, generateAllKnightMoves, generateAllKingMoves, generateAllPawnMoves, generateAllPotentialMoves, boardAfterMove, generateAllMoves) where import Chess.Internal.Piece import Chess.Internal.Board import Data.Maybe data GameState = State { GameState -> Board stateBoard :: Board , GameState -> Color currentPlayer :: Color , GameState -> [CastlingType] whiteCastlingsPossible :: [CastlingType] , GameState -> [CastlingType] blackCastlingsPossible :: [CastlingType] , GameState -> Maybe Coordinates enPassantSquare :: Maybe Coordinates , GameState -> Integer halfmoveClock :: Integer , GameState -> Integer moveNumber :: Integer } deriving (GameState -> GameState -> Bool (GameState -> GameState -> Bool) -> (GameState -> GameState -> Bool) -> Eq GameState forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: GameState -> GameState -> Bool $c/= :: GameState -> GameState -> Bool == :: GameState -> GameState -> Bool $c== :: GameState -> GameState -> Bool Eq, Int -> GameState -> ShowS [GameState] -> ShowS GameState -> String (Int -> GameState -> ShowS) -> (GameState -> String) -> ([GameState] -> ShowS) -> Show GameState forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [GameState] -> ShowS $cshowList :: [GameState] -> ShowS show :: GameState -> String $cshow :: GameState -> String showsPrec :: Int -> GameState -> ShowS $cshowsPrec :: Int -> GameState -> ShowS Show) data Move = Movement Piece Coordinates Coordinates | Capture Piece Coordinates Coordinates | Castling Color CastlingType | EnPassant Piece Coordinates Coordinates | Promotion Piece Coordinates Coordinates PieceType | PawnDoubleMove Piece Coordinates Coordinates deriving (Int -> Move -> ShowS [Move] -> ShowS Move -> String (Int -> Move -> ShowS) -> (Move -> String) -> ([Move] -> ShowS) -> Show Move forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Move] -> ShowS $cshowList :: [Move] -> ShowS show :: Move -> String $cshow :: Move -> String showsPrec :: Int -> Move -> ShowS $cshowsPrec :: Int -> Move -> ShowS Show, Move -> Move -> Bool (Move -> Move -> Bool) -> (Move -> Move -> Bool) -> Eq Move forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Move -> Move -> Bool $c/= :: Move -> Move -> Bool == :: Move -> Move -> Bool $c== :: Move -> Move -> Bool Eq) data CastlingType = Short | Long deriving (Int -> CastlingType -> ShowS [CastlingType] -> ShowS CastlingType -> String (Int -> CastlingType -> ShowS) -> (CastlingType -> String) -> ([CastlingType] -> ShowS) -> Show CastlingType forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CastlingType] -> ShowS $cshowList :: [CastlingType] -> ShowS show :: CastlingType -> String $cshow :: CastlingType -> String showsPrec :: Int -> CastlingType -> ShowS $cshowsPrec :: Int -> CastlingType -> ShowS Show, CastlingType -> CastlingType -> Bool (CastlingType -> CastlingType -> Bool) -> (CastlingType -> CastlingType -> Bool) -> Eq CastlingType forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CastlingType -> CastlingType -> Bool $c/= :: CastlingType -> CastlingType -> Bool == :: CastlingType -> CastlingType -> Bool $c== :: CastlingType -> CastlingType -> Bool Eq, Eq CastlingType Eq CastlingType -> (CastlingType -> CastlingType -> Ordering) -> (CastlingType -> CastlingType -> Bool) -> (CastlingType -> CastlingType -> Bool) -> (CastlingType -> CastlingType -> Bool) -> (CastlingType -> CastlingType -> Bool) -> (CastlingType -> CastlingType -> CastlingType) -> (CastlingType -> CastlingType -> CastlingType) -> Ord CastlingType CastlingType -> CastlingType -> Bool CastlingType -> CastlingType -> Ordering CastlingType -> CastlingType -> CastlingType forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: CastlingType -> CastlingType -> CastlingType $cmin :: CastlingType -> CastlingType -> CastlingType max :: CastlingType -> CastlingType -> CastlingType $cmax :: CastlingType -> CastlingType -> CastlingType >= :: CastlingType -> CastlingType -> Bool $c>= :: CastlingType -> CastlingType -> Bool > :: CastlingType -> CastlingType -> Bool $c> :: CastlingType -> CastlingType -> Bool <= :: CastlingType -> CastlingType -> Bool $c<= :: CastlingType -> CastlingType -> Bool < :: CastlingType -> CastlingType -> Bool $c< :: CastlingType -> CastlingType -> Bool compare :: CastlingType -> CastlingType -> Ordering $ccompare :: CastlingType -> CastlingType -> Ordering $cp1Ord :: Eq CastlingType Ord) data MoveError = WrongPlayer | WrongPiece | InvalidMove | InCheck | InvalidCoordinates deriving (Int -> MoveError -> ShowS [MoveError] -> ShowS MoveError -> String (Int -> MoveError -> ShowS) -> (MoveError -> String) -> ([MoveError] -> ShowS) -> Show MoveError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [MoveError] -> ShowS $cshowList :: [MoveError] -> ShowS show :: MoveError -> String $cshow :: MoveError -> String showsPrec :: Int -> MoveError -> ShowS $cshowsPrec :: Int -> MoveError -> ShowS Show, MoveError -> MoveError -> Bool (MoveError -> MoveError -> Bool) -> (MoveError -> MoveError -> Bool) -> Eq MoveError forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: MoveError -> MoveError -> Bool $c/= :: MoveError -> MoveError -> Bool == :: MoveError -> MoveError -> Bool $c== :: MoveError -> MoveError -> Bool Eq) initialState :: GameState initialState :: GameState initialState = Board -> Color -> [CastlingType] -> [CastlingType] -> Maybe Coordinates -> Integer -> Integer -> GameState State Board initialBoard Color White [CastlingType Short, CastlingType Long] [CastlingType Short, CastlingType Long] Maybe Coordinates forall a. Maybe a Nothing Integer 0 Integer 1 generateAllMoves :: GameState -> [Move] generateAllMoves :: GameState -> [Move] generateAllMoves GameState game = (Move -> Bool) -> [Move] -> [Move] forall a. (a -> Bool) -> [a] -> [a] filter Move -> Bool isLegalMove ([Move] -> [Move]) -> [Move] -> [Move] forall a b. (a -> b) -> a -> b $ GameState -> [Move] generateAllPotentialMoves GameState game where isLegalMove :: Move -> Bool isLegalMove Move move = Maybe MoveError -> Bool forall a. Maybe a -> Bool isNothing (GameState -> Move -> Maybe MoveError isMoveError GameState game Move move) isInCheckAfterMove :: GameState -> Move -> Bool isInCheckAfterMove :: GameState -> Move -> Bool isInCheckAfterMove GameState game Move move = case Maybe Board newBoard of Maybe Board Nothing -> Bool False Just Board b -> Board -> Color -> Bool isCheck Board b (GameState -> Color currentPlayer GameState game) where board :: Board board = GameState -> Board stateBoard GameState game newBoard :: Maybe Board newBoard = Board -> Move -> Maybe Board boardAfterMove Board board Move move isCorrectPiece :: GameState -> Move -> Bool isCorrectPiece :: GameState -> Move -> Bool isCorrectPiece (State Board board Color _ [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Movement Piece piece Coordinates start Coordinates _) = Board -> Piece -> Coordinates -> Bool isCorrectStartPiece Board board Piece piece Coordinates start isCorrectPiece (State Board board Color _ [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Capture Piece piece Coordinates start Coordinates _) = Board -> Piece -> Coordinates -> Bool isCorrectStartPiece Board board Piece piece Coordinates start isCorrectPiece (State Board board Color _ [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (EnPassant Piece piece Coordinates start Coordinates _) = Board -> Piece -> Coordinates -> Bool isCorrectStartPiece Board board Piece piece Coordinates start isCorrectPiece (State Board board Color _ [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (Promotion Piece piece Coordinates start Coordinates _ PieceType _) = Board -> Piece -> Coordinates -> Bool isCorrectStartPiece Board board Piece piece Coordinates start isCorrectPiece (State Board board Color _ [CastlingType] _ [CastlingType] _ Maybe Coordinates _ Integer _ Integer _) (PawnDoubleMove Piece piece Coordinates start Coordinates _) = Board -> Piece -> Coordinates -> Bool isCorrectStartPiece Board board Piece piece Coordinates start isCorrectPiece GameState _ (Castling Color _ CastlingType _) = Bool True isMoveError :: GameState -> Move -> Maybe MoveError isMoveError :: GameState -> Move -> Maybe MoveError isMoveError GameState game Move move | Bool -> Bool not (GameState -> Move -> Bool isCorrectPlayer GameState game Move move) = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError WrongPlayer | Bool -> Bool not (GameState -> Move -> Bool isCorrectPiece GameState game Move move) = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError WrongPiece | Bool -> Bool not (GameState -> Move -> Bool isCorrectBoardMove GameState game Move move) = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError InvalidCoordinates | GameState -> Move -> Bool isInCheckAfterMove GameState game Move move = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError InCheck | Move move Move -> [Move] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` GameState -> [Move] generateAllPotentialMoves GameState game = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError InvalidMove | Bool otherwise = Maybe MoveError forall a. Maybe a Nothing isCorrectBoardMove :: GameState -> Move -> Bool isCorrectBoardMove :: GameState -> Move -> Bool isCorrectBoardMove GameState game Move move = Maybe Board -> Bool forall a. Maybe a -> Bool isJust (Board -> Move -> Maybe Board boardAfterMove (GameState -> Board stateBoard GameState game) Move move) isCorrectStartPiece :: Board -> Piece -> Coordinates -> Bool isCorrectStartPiece :: Board -> Piece -> Coordinates -> Bool isCorrectStartPiece Board board (Piece Color color PieceType pieceType) Coordinates coordinates = case Maybe Piece boardPiece of Maybe Piece Nothing -> Bool False Just (Piece Color color' PieceType pieceType') -> Color color Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color' Bool -> Bool -> Bool && PieceType pieceType PieceType -> PieceType -> Bool forall a. Eq a => a -> a -> Bool == PieceType pieceType' where boardPiece :: Maybe Piece boardPiece = Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates coordinates isCorrectPlayer :: GameState -> Move -> Bool isCorrectPlayer :: GameState -> Move -> Bool isCorrectPlayer GameState game = Color -> Move -> Bool isRightPlayerMove (GameState -> Color currentPlayer GameState game) isRightPlayerMove :: Color -> Move -> Bool isRightPlayerMove :: Color -> Move -> Bool isRightPlayerMove Color player (Movement (Piece Color color PieceType _) Coordinates _ Coordinates _) = Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color isRightPlayerMove Color player (Capture (Piece Color color PieceType _) Coordinates _ Coordinates _) = Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color isRightPlayerMove Color player (Castling Color color CastlingType _) = Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color isRightPlayerMove Color player (EnPassant (Piece Color color PieceType _) Coordinates _ Coordinates _) = Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color isRightPlayerMove Color player (Promotion (Piece Color color PieceType _) Coordinates _ Coordinates _ PieceType _) = Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color isRightPlayerMove Color player (PawnDoubleMove (Piece Color color PieceType _) Coordinates _ Coordinates _) = Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color color areCoordinatesValid :: Coordinates -> Coordinates -> Maybe MoveError areCoordinatesValid :: Coordinates -> Coordinates -> Maybe MoveError areCoordinatesValid Coordinates start Coordinates end | Coordinates start Coordinates -> Coordinates -> Bool forall a. Eq a => a -> a -> Bool == Coordinates end = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError InvalidCoordinates | Bool -> Bool not (Coordinates -> Bool isInsideBoard Coordinates start) Bool -> Bool -> Bool || Bool -> Bool not (Coordinates -> Bool isInsideBoard Coordinates end) = MoveError -> Maybe MoveError forall a. a -> Maybe a Just MoveError InvalidCoordinates | Bool otherwise = Maybe MoveError forall a. Maybe a Nothing generateAllRookMoves :: GameState -> Coordinates -> [Move] generateAllRookMoves :: GameState -> Coordinates -> [Move] generateAllRookMoves GameState game Coordinates coords = GameState -> Coordinates -> [Coordinates] -> [Move] patternMoves GameState game Coordinates coords [Coordinates] rookPattern generateAllBishopMoves :: GameState -> Coordinates -> [Move] generateAllBishopMoves :: GameState -> Coordinates -> [Move] generateAllBishopMoves GameState game Coordinates coords = GameState -> Coordinates -> [Coordinates] -> [Move] patternMoves GameState game Coordinates coords [Coordinates] bishopPattern generateAllQueenMoves :: GameState -> Coordinates -> [Move] generateAllQueenMoves :: GameState -> Coordinates -> [Move] generateAllQueenMoves GameState game Coordinates coords = GameState -> Coordinates -> [Coordinates] -> [Move] patternMoves GameState game Coordinates coords [Coordinates] queenPattern generateAllKnightMoves :: GameState -> Coordinates -> [Move] generateAllKnightMoves :: GameState -> Coordinates -> [Move] generateAllKnightMoves GameState game Coordinates coords = (Coordinates -> Move) -> [Coordinates] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> Move Movement Piece piece Coordinates coords) [Coordinates] emptySquares [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ (Coordinates -> Move) -> [Coordinates] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> Move Capture Piece piece Coordinates coords) [Coordinates] opponentSquares where squares :: [Coordinates] squares = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter Coordinates -> Bool isInsideBoard [Coordinates -> Coordinates -> Coordinates sumSquares Coordinates coords Coordinates jump | Coordinates jump <- [Coordinates] knightPattern] board :: Board board = GameState -> Board stateBoard GameState game emptySquares :: [Coordinates] emptySquares = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter (Board -> Coordinates -> Bool isEmpty Board board) [Coordinates] squares piece :: Piece piece@(Piece Color player PieceType _) = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates coords opponentSquares :: [Coordinates] opponentSquares = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter (\Coordinates square -> Board -> Coordinates -> Color -> Bool isOpponentSquare Board board Coordinates square Color player) [Coordinates] squares generateAllKingMoves :: GameState -> Coordinates -> [Move] generateAllKingMoves :: GameState -> Coordinates -> [Move] generateAllKingMoves GameState game Coordinates coords = (Coordinates -> Move) -> [Coordinates] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> Move Movement Piece piece Coordinates coords) [Coordinates] moveSquares [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ (Coordinates -> Move) -> [Coordinates] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> Move Capture Piece piece Coordinates coords) [Coordinates] captureSquares [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ GameState -> Coordinates -> [Move] kingCastlingMoves GameState game Coordinates coords where board :: Board board = GameState -> Board stateBoard GameState game piece :: Piece piece = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates coords moveSquares :: [Coordinates] moveSquares = GameState -> Coordinates -> [Coordinates] kingMoveSquares GameState game Coordinates coords captureSquares :: [Coordinates] captureSquares = GameState -> Coordinates -> [Coordinates] kingCaptureSquares GameState game Coordinates coords generateAllPawnMoves :: GameState -> Coordinates -> [Move] generateAllPawnMoves :: GameState -> Coordinates -> [Move] generateAllPawnMoves GameState game coords :: Coordinates coords@(Int row, Int _) = [Move] move [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ [Move] doubleMove [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ [Move] captures [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ [Move] promotions [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ [Move] enpassant where board :: Board board = GameState -> Board stateBoard GameState game (Piece Color player PieceType _) = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates coords isOnStartRow :: Bool isOnStartRow = case Color player of Color White -> Int row Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 6 Color Black -> Int row Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 1 isNextToPromotionRow :: Bool isNextToPromotionRow = case Color player of Color White -> Int row Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 1 Color Black -> Int row Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 6 moveDirection :: Int moveDirection = case Color player of Color White -> -Int 1 Color Black -> Int 1 moveSquare :: Coordinates moveSquare = Coordinates -> Coordinates -> Coordinates sumSquares Coordinates coords (Int moveDirection, Int 0) doubleMoveSquare :: Coordinates doubleMoveSquare = Coordinates -> Coordinates -> Coordinates sumSquares Coordinates coords (Int moveDirection Int -> Int -> Int forall a. Num a => a -> a -> a * Int 2, Int 0) captureSquares :: [Coordinates] captureSquares = (Coordinates -> Coordinates) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> [a] -> [b] map (Coordinates -> Coordinates -> Coordinates sumSquares Coordinates coords) [(Int moveDirection, -Int 1), (Int moveDirection, Int 1)] move :: [Move] move = [Piece -> Coordinates -> Coordinates -> Move Movement (Color -> PieceType -> Piece Piece Color player PieceType Pawn) Coordinates coords Coordinates moveSquare | Board -> Coordinates -> Bool isEmpty Board board Coordinates moveSquare Bool -> Bool -> Bool && Bool -> Bool not Bool isNextToPromotionRow] doubleMove :: [Move] doubleMove = [Piece -> Coordinates -> Coordinates -> Move PawnDoubleMove (Color -> PieceType -> Piece Piece Color player PieceType Pawn) Coordinates coords Coordinates doubleMoveSquare | Board -> Coordinates -> Bool isEmpty Board board Coordinates moveSquare Bool -> Bool -> Bool && Board -> Coordinates -> Bool isEmpty Board board Coordinates doubleMoveSquare Bool -> Bool -> Bool && Bool isOnStartRow] capture :: Coordinates -> [Move] capture Coordinates square = [Piece -> Coordinates -> Coordinates -> Move Capture (Color -> PieceType -> Piece Piece Color player PieceType Pawn) Coordinates coords Coordinates square | Board -> Coordinates -> Color -> Bool isOpponentSquare Board board Coordinates square Color player Bool -> Bool -> Bool && Bool -> Bool not Bool isNextToPromotionRow] captures :: [Move] captures = (Coordinates -> [Move]) -> [Coordinates] -> [Move] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Coordinates -> [Move] capture [Coordinates] captureSquares promotionCapture :: Coordinates -> [Move] promotionCapture Coordinates square = if Board -> Coordinates -> Color -> Bool isOpponentSquare Board board Coordinates square Color player then (PieceType -> Move) -> [PieceType] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> PieceType -> Move Promotion (Color -> PieceType -> Piece Piece Color player PieceType Pawn) Coordinates coords Coordinates square) [PieceType Rook, PieceType Bishop, PieceType Knight, PieceType Queen] else [] promotionMove :: Coordinates -> [Move] promotionMove Coordinates square = if Board -> Coordinates -> Bool isEmpty Board board Coordinates square then (PieceType -> Move) -> [PieceType] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> PieceType -> Move Promotion (Color -> PieceType -> Piece Piece Color player PieceType Pawn) Coordinates coords Coordinates square) [PieceType Rook, PieceType Bishop, PieceType Knight, PieceType Queen] else [] promotions :: [Move] promotions = if Bool isNextToPromotionRow then (Coordinates -> [Move]) -> [Coordinates] -> [Move] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Coordinates -> [Move] promotionCapture [Coordinates] captureSquares [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ Coordinates -> [Move] promotionMove Coordinates moveSquare else [] epSquare :: Maybe Coordinates epSquare = GameState -> Maybe Coordinates enPassantSquare GameState game enpassant :: [Move] enpassant = case Maybe Coordinates epSquare of Just Coordinates square -> [Piece -> Coordinates -> Coordinates -> Move EnPassant (Color -> PieceType -> Piece Piece Color player PieceType Pawn) Coordinates coords Coordinates square | Coordinates square Coordinates -> [Coordinates] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [Coordinates] captureSquares] Maybe Coordinates Nothing -> [] kingMoveSquares :: GameState -> Coordinates -> [Coordinates] kingMoveSquares :: GameState -> Coordinates -> [Coordinates] kingMoveSquares GameState game Coordinates start = [Coordinates] emptySquares where allSquares :: [Coordinates] allSquares = (Coordinates -> Coordinates) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> [a] -> [b] map (Coordinates -> Coordinates -> Coordinates sumSquares Coordinates start) [Coordinates] queenPattern board :: Board board = GameState -> Board stateBoard GameState game emptySquares :: [Coordinates] emptySquares = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter (Board -> Coordinates -> Bool isEmpty Board board) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> a -> b $ (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter Coordinates -> Bool isInsideBoard [Coordinates] allSquares kingCaptureSquares :: GameState -> Coordinates -> [Coordinates] kingCaptureSquares :: GameState -> Coordinates -> [Coordinates] kingCaptureSquares GameState game Coordinates start = [Coordinates] opponentSquares where allSquares :: [Coordinates] allSquares = (Coordinates -> Coordinates) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> [a] -> [b] map (Coordinates -> Coordinates -> Coordinates sumSquares Coordinates start) [Coordinates] queenPattern board :: Board board = GameState -> Board stateBoard GameState game (Piece Color player PieceType _) = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates start opponentSquares :: [Coordinates] opponentSquares = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter (\Coordinates square -> Board -> Coordinates -> Color -> Bool isOpponentSquare Board board Coordinates square Color player) ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates] forall a b. (a -> b) -> a -> b $ (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] filter Coordinates -> Bool isInsideBoard [Coordinates] allSquares kingCastlingMoves :: GameState -> Coordinates -> [Move] kingCastlingMoves :: GameState -> Coordinates -> [Move] kingCastlingMoves GameState game Coordinates coords = (CastlingType -> Move) -> [CastlingType] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Color -> CastlingType -> Move Castling Color player) ([CastlingType] -> [Move]) -> [CastlingType] -> [Move] forall a b. (a -> b) -> a -> b $ (CastlingType -> Bool) -> [CastlingType] -> [CastlingType] forall a. (a -> Bool) -> [a] -> [a] filter (GameState -> Color -> CastlingType -> Bool isCastlingPossible GameState game Color player) [CastlingType Long, CastlingType Short] where board :: Board board = GameState -> Board stateBoard GameState game (Piece Color player PieceType _) = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates coords isCastlingPossible :: GameState -> Color -> CastlingType -> Bool isCastlingPossible :: GameState -> Color -> CastlingType -> Bool isCastlingPossible GameState game Color player CastlingType castling = CastlingType castling CastlingType -> [CastlingType] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` Color -> [CastlingType] possibleCastlings Color player Bool -> Bool -> Bool && (Coordinates -> Bool) -> [Coordinates] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (Board -> Coordinates -> Bool isEmpty Board board) [Coordinates] squares Bool -> Bool -> Bool && Bool traverseSquaresNotThreatened where squares :: [Coordinates] squares = Color -> CastlingType -> [Coordinates] castlingSquares Color player CastlingType castling board :: Board board = GameState -> Board stateBoard GameState game possibleCastlings :: Color -> [CastlingType] possibleCastlings Color White = GameState -> [CastlingType] whiteCastlingsPossible GameState game possibleCastlings Color Black = GameState -> [CastlingType] blackCastlingsPossible GameState game kingSquare :: Coordinates kingSquare = if Color player Color -> Color -> Bool forall a. Eq a => a -> a -> Bool == Color White then (Int 7, Int 4) else (Int 0, Int 4) traverseSquaresNotThreatened :: Bool traverseSquaresNotThreatened = Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ (Coordinates -> Bool) -> [Coordinates] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (Board -> Color -> Coordinates -> Bool isSquareThreatened Board board (Color -> Color opponent Color player)) (Coordinates kingSquare Coordinates -> [Coordinates] -> [Coordinates] forall a. a -> [a] -> [a] : [Coordinates] squares) castlingSquares :: Color -> CastlingType -> [Coordinates] castlingSquares :: Color -> CastlingType -> [Coordinates] castlingSquares Color White CastlingType Long = [(Int 7, Int 1), (Int 7, Int 2), (Int 7, Int 3)] castlingSquares Color White CastlingType Short = [(Int 7, Int 5), (Int 7, Int 6)] castlingSquares Color Black CastlingType Long = [(Int 0, Int 1), (Int 0, Int 2), (Int 0, Int 3)] castlingSquares Color Black CastlingType Short = [(Int 0, Int 5), (Int 0, Int 6)] patternMoves :: GameState -> Coordinates -> [(Int, Int)] -> [Move] patternMoves :: GameState -> Coordinates -> [Coordinates] -> [Move] patternMoves GameState game Coordinates start [Coordinates] pattern' = [[Move]] -> [Move] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [GameState -> Coordinates -> Coordinates -> [Move] movementsInDirection GameState game Coordinates start Coordinates dir | Coordinates dir <- [Coordinates] pattern'] [Move] -> [Move] -> [Move] forall a. [a] -> [a] -> [a] ++ [[Move]] -> [Move] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [GameState -> Coordinates -> Coordinates -> [Move] capturesInDirection GameState game Coordinates start Coordinates dir | Coordinates dir <- [Coordinates] pattern'] movementsInDirection :: GameState -> Coordinates -> (Int, Int) -> [Move] movementsInDirection :: GameState -> Coordinates -> Coordinates -> [Move] movementsInDirection GameState game Coordinates start Coordinates direction = (Coordinates -> Move) -> [Coordinates] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> Move Movement Piece piece Coordinates start) [Coordinates] squares where piece :: Piece piece = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece (GameState -> Board stateBoard GameState game) Coordinates start squares :: [Coordinates] squares = GameState -> Coordinates -> Coordinates -> [Coordinates] iterateMovementSquares GameState game Coordinates start Coordinates direction capturesInDirection :: GameState -> Coordinates -> (Int, Int) -> [Move] capturesInDirection :: GameState -> Coordinates -> Coordinates -> [Move] capturesInDirection GameState game Coordinates start Coordinates direction = (Coordinates -> Move) -> [Coordinates] -> [Move] forall a b. (a -> b) -> [a] -> [b] map (Piece -> Coordinates -> Coordinates -> Move Capture Piece piece Coordinates start) [Coordinates] squares where piece :: Piece piece = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece (GameState -> Board stateBoard GameState game) Coordinates start squares :: [Coordinates] squares = GameState -> Coordinates -> Coordinates -> [Coordinates] iterateCaptureSquares GameState game Coordinates start Coordinates direction iterateMovementSquares :: GameState -> Coordinates -> (Int, Int) -> [Coordinates] iterateMovementSquares :: GameState -> Coordinates -> Coordinates -> [Coordinates] iterateMovementSquares = (GameState -> Coordinates -> Bool) -> GameState -> Coordinates -> Coordinates -> [Coordinates] iterateDirection GameState -> Coordinates -> Bool isEmptySquare where isEmptySquare :: GameState -> Coordinates -> Bool isEmptySquare GameState game' = Board -> Coordinates -> Bool isEmpty (GameState -> Board stateBoard GameState game') iterateCaptureSquares :: GameState -> Coordinates -> (Int, Int) -> [Coordinates] iterateCaptureSquares :: GameState -> Coordinates -> Coordinates -> [Coordinates] iterateCaptureSquares GameState game Coordinates start Coordinates direction = case [Coordinates] squaresNotEmpty of [] -> [] (Coordinates first:[Coordinates] _) -> [Coordinates first | Board -> Coordinates -> Color -> Bool isOpponentSquare Board board Coordinates first Color player] where squares :: [Coordinates] squares = Coordinates -> Coordinates -> [Coordinates] iterateDirectionInsideBoard Coordinates start Coordinates direction board :: Board board = GameState -> Board stateBoard GameState game (Piece Color player PieceType _) = Maybe Piece -> Piece forall a. HasCallStack => Maybe a -> a fromJust (Maybe Piece -> Piece) -> Maybe Piece -> Piece forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates start squaresNotEmpty :: [Coordinates] squaresNotEmpty = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] dropWhile (Board -> Coordinates -> Bool isEmpty Board board) [Coordinates] squares iterateDirection :: (GameState -> Coordinates -> Bool) -> GameState -> Coordinates -> (Int, Int) -> [Coordinates] iterateDirection :: (GameState -> Coordinates -> Bool) -> GameState -> Coordinates -> Coordinates -> [Coordinates] iterateDirection GameState -> Coordinates -> Bool condition GameState game Coordinates start Coordinates direction = (Coordinates -> Bool) -> [Coordinates] -> [Coordinates] forall a. (a -> Bool) -> [a] -> [a] takeWhile (GameState -> Coordinates -> Bool condition GameState game) [Coordinates] squares where squares :: [Coordinates] squares = Coordinates -> Coordinates -> [Coordinates] iterateDirectionInsideBoard Coordinates start Coordinates direction generateAllPotentialMoves :: GameState -> [Move] generateAllPotentialMoves :: GameState -> [Move] generateAllPotentialMoves GameState game = (Coordinates -> [Move]) -> [Coordinates] -> [Move] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (GameState -> Coordinates -> [Move] generateSquareMoves GameState game) [Coordinates] squares where player :: Color player = GameState -> Color currentPlayer GameState game board :: Board board = GameState -> Board stateBoard GameState game squares :: [Coordinates] squares = Board -> Color -> [Coordinates] getSquaresWithOwner Board board Color player generateSquareMoves :: GameState -> Coordinates -> [Move] generateSquareMoves :: GameState -> Coordinates -> [Move] generateSquareMoves GameState game Coordinates coordinates = case Board -> Coordinates -> Maybe Piece getPiece Board board Coordinates coordinates of Maybe Piece Nothing -> [] Just (Piece Color _ PieceType Pawn) -> GameState -> Coordinates -> [Move] generateAllPawnMoves GameState game Coordinates coordinates Just (Piece Color _ PieceType Rook) -> GameState -> Coordinates -> [Move] generateAllRookMoves GameState game Coordinates coordinates Just (Piece Color _ PieceType Bishop) -> GameState -> Coordinates -> [Move] generateAllBishopMoves GameState game Coordinates coordinates Just (Piece Color _ PieceType Queen) -> GameState -> Coordinates -> [Move] generateAllQueenMoves GameState game Coordinates coordinates Just (Piece Color _ PieceType King) -> GameState -> Coordinates -> [Move] generateAllKingMoves GameState game Coordinates coordinates Just (Piece Color _ PieceType Knight) -> GameState -> Coordinates -> [Move] generateAllKnightMoves GameState game Coordinates coordinates where board :: Board board = GameState -> Board stateBoard GameState game boardAfterMove :: Board -> Move -> Maybe Board boardAfterMove :: Board -> Move -> Maybe Board boardAfterMove Board board (Movement Piece _ Coordinates from Coordinates to) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece Coordinates from Coordinates to Board board boardAfterMove Board board (Capture Piece _ Coordinates from Coordinates to) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece Coordinates from Coordinates to Board board boardAfterMove Board board (PawnDoubleMove Piece _ Coordinates from Coordinates to) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece Coordinates from Coordinates to Board board boardAfterMove Board board (Castling Color White CastlingType Long) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 7, Int 0) (Int 7, Int 3) Board board Maybe Board -> (Board -> Maybe Board) -> Maybe Board forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 7, Int 4) (Int 7, Int 2) boardAfterMove Board board (Castling Color White CastlingType Short) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 7, Int 7) (Int 7, Int 5) Board board Maybe Board -> (Board -> Maybe Board) -> Maybe Board forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 7, Int 4) (Int 7, Int 6) boardAfterMove Board board (Castling Color Black CastlingType Long) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 0, Int 0) (Int 0, Int 3) Board board Maybe Board -> (Board -> Maybe Board) -> Maybe Board forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 0, Int 4) (Int 0, Int 2) boardAfterMove Board board (Castling Color Black CastlingType Short) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 0, Int 7) (Int 0, Int 5) Board board Maybe Board -> (Board -> Maybe Board) -> Maybe Board forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Coordinates -> Coordinates -> Board -> Maybe Board movePiece (Int 0, Int 4) (Int 0, Int 6) boardAfterMove Board board (EnPassant (Piece Color player PieceType _) Coordinates from to :: Coordinates to@(Int row, Int col)) = Coordinates -> Coordinates -> Board -> Maybe Board movePiece Coordinates from Coordinates to (Board -> Coordinates -> Board removePiece Board board (Color -> Coordinates epSquare Color player)) where epSquare :: Color -> Coordinates epSquare Color White = (Int row Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1, Int col) epSquare Color Black = (Int row Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1, Int col) boardAfterMove Board board (Promotion (Piece Color player PieceType _) Coordinates from Coordinates to PieceType promotiontype) = case Coordinates -> Coordinates -> Board -> Maybe Board movePiece Coordinates from Coordinates to Board board of Just Board newboard -> Board -> Maybe Board forall a. a -> Maybe a Just (Board -> Maybe Board) -> Board -> Maybe Board forall a b. (a -> b) -> a -> b $ Board -> Coordinates -> Piece -> Board addPiece Board newboard Coordinates to (Color -> PieceType -> Piece Piece Color player PieceType promotiontype) Maybe Board Nothing -> Maybe Board forall a. Maybe a Nothing