{-# LANGUAGE GADTs #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Rulebook.Standard.Movement
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Implementation of the movement rules, according to the standard rulebook.
-----------------------------------------------------------------------------
module Chess.Rulebook.Standard.Movement where

import Chess.Board.PlacedPiece                 (PlacedPiece)
import Chess.Game                              (Game(Game, board))
import Chess.Game.Command                      (Command)
import Chess.Piece                             (PieceType(..))
import Chess.Rulebook.Standard.Movement.Bishop qualified as Bishop
import Chess.Rulebook.Standard.Movement.King   qualified as King
import Chess.Rulebook.Standard.Movement.Knight qualified as Knight
import Chess.Rulebook.Standard.Movement.Pawn   qualified as Pawn
import Chess.Rulebook.Standard.Movement.Queen  qualified as Queen
import Chess.Rulebook.Standard.Movement.Rook   qualified as Rook

-- | Determines all possible movements (including captures and promotions) for a given chess piece.
movements :: PlacedPiece t -> Game -> [Command]
movements :: forall (t :: PieceType'). PlacedPiece t -> Game -> [Command]
movements PlacedPiece t
piece game :: Game
game@Game{Board
board :: Board
$sel:board:Game :: Game -> Board
board} =
  case PlacedPiece t
piece.type' of
    PieceType t
Pawn   -> PlacedPiece 'Pawn' -> Game -> [Command]
Pawn.movements PlacedPiece t
piece Game
game
    PieceType t
Knight -> PlacedPiece 'Knight' -> Board -> [Command]
Knight.movements PlacedPiece t
piece Board
board
    PieceType t
Bishop -> PlacedPiece 'Bishop' -> Board -> [Command]
Bishop.movements PlacedPiece t
piece Board
board
    PieceType t
Rook   -> PlacedPiece 'Rook' -> Board -> [Command]
Rook.movements PlacedPiece t
piece Board
board
    PieceType t
Queen  -> PlacedPiece 'Queen' -> Board -> [Command]
Queen.movements PlacedPiece t
piece Board
board
    PieceType t
King   -> PlacedPiece 'King' -> Game -> [Command]
King.movements PlacedPiece t
piece Game
game