{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE OverloadedLists #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Rulebook.Standard.Movement.Pawn
-- 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 rule for pawns, according to the standard
-- rulebook.
-----------------------------------------------------------------------------
module Chess.Rulebook.Standard.Movement.Pawn
  ( movements
  , oneStep
  , twoSteps
  , capture
  , enPassant
  ) where

-- base
import Control.Applicative ((<|>))
import Control.Monad       (guard)
import Data.Maybe          (maybeToList)
import Prelude hiding      (lookup)

import Chess.Board                    (Board, isOccupied, lookup)
import Chess.Board.Direction          (Direction, up, down)
import Chess.Board.PlacedPiece        (PlacedPiece(..))
import Chess.Board.Position           (Position(..), boundedPosition, offset)
import Chess.Color                    (Color(..))
import Chess.Game                     (Game(..), Update(command))
import Chess.Game.Command             (Command(..), move, promote, destroy)
import Chess.Piece                    (Piece(Piece), PieceType(..), PieceType'(Pawn'), isOfType)
import Chess.Rulebook.Standard.Threat (threats)
import Chess.Some                     (Some(Some))

-- | Determines all possible movements (including captures, promotions and en
-- passant) for a given pawn.
movements :: PlacedPiece Pawn' -> Game -> [Command]
movements :: PlacedPiece 'Pawn' -> Game -> [Command]
movements PlacedPiece 'Pawn'
pawn game :: Game
game@Game{Board
$sel:board:Game :: Game -> Board
board :: Board
board}
    = PlacedPiece 'Pawn' -> Board -> [Command]
oneStep PlacedPiece 'Pawn'
pawn Board
board
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PlacedPiece 'Pawn' -> Board -> [Command]
twoSteps PlacedPiece 'Pawn'
pawn Board
board
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PlacedPiece 'Pawn' -> Board -> [Command]
capture PlacedPiece 'Pawn'
pawn Board
board
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a -> [a]
maybeToList (PlacedPiece 'Pawn' -> Game -> Maybe Command
enPassant PlacedPiece 'Pawn'
pawn Game
game)

-- | Determines all possible one-step forward movements (including promotions)
-- for a given pawn.
oneStep :: PlacedPiece Pawn' -> Board -> [Command]
oneStep :: PlacedPiece 'Pawn' -> Board -> [Command]
oneStep PlacedPiece 'Pawn'
pawn Board
board = do
  let pawnDirection :: Direction
pawnDirection = PlacedPiece 'Pawn' -> Direction
direction PlacedPiece 'Pawn'
pawn
  Position
forward <- forall (f :: * -> *).
Alternative f =>
Direction -> Position -> f Position
offset Direction
pawnDirection PlacedPiece 'Pawn'
pawn.position
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Position -> Board -> Bool
isOccupied Position
forward Board
board
  Position -> PlacedPiece 'Pawn' -> Command -> [Command]
maybePromote Position
forward PlacedPiece 'Pawn'
pawn (forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
forward PlacedPiece 'Pawn'
pawn)

-- | Determines all possible two-step forward movements for a given pawn.
twoSteps :: PlacedPiece Pawn' -> Board -> [Command]
twoSteps :: PlacedPiece 'Pawn' -> Board -> [Command]
twoSteps PlacedPiece 'Pawn'
pawn Board
board = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$
    case PlacedPiece 'Pawn'
pawn.color of
      Color
White -> PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Int
1
      Color
Black -> PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Int
6
  let pawnDirection :: Direction
pawnDirection = PlacedPiece 'Pawn' -> Direction
direction PlacedPiece 'Pawn'
pawn
  Position
oneForward <- forall (f :: * -> *).
Alternative f =>
Direction -> Position -> f Position
offset Direction
pawnDirection PlacedPiece 'Pawn'
pawn.position
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Position -> Board -> Bool
isOccupied Position
oneForward Board
board
  Position
twoForward <- forall (f :: * -> *).
Alternative f =>
Direction -> Position -> f Position
offset Direction
pawnDirection Position
oneForward
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Position -> Board -> Bool
isOccupied Position
twoForward Board
board
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
twoForward PlacedPiece 'Pawn'
pawn)

-- | Determines all possible capture movements (including promotions, excluding
-- en passant) for a given pawn.
capture :: PlacedPiece Pawn' -> Board -> [Command]
capture :: PlacedPiece 'Pawn' -> Board -> [Command]
capture PlacedPiece 'Pawn'
pawn Board
board = do
  Position
target     <- forall (t :: PieceType'). PlacedPiece t -> Board -> [Position]
threats PlacedPiece 'Pawn'
pawn Board
board
  Some PlacedPiece t
enemy <- forall (f :: * -> *).
Alternative f =>
Position -> Board -> f (Some PlacedPiece)
lookup Position
target Board
board
  Position -> PlacedPiece 'Pawn' -> Command -> [Command]
maybePromote Position
target PlacedPiece 'Pawn'
pawn [forall (t :: PieceType'). PlacedPiece t -> Command
destroy PlacedPiece t
enemy, forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
target PlacedPiece 'Pawn'
pawn]

-- | Determines the en passant movement for a given pawn, if possible.
enPassant :: PlacedPiece Pawn' -> Game -> Maybe Command
enPassant :: PlacedPiece 'Pawn' -> Game -> Maybe Command
enPassant PlacedPiece 'Pawn'
pawn Game
game =
  let
    expectedRow :: Int
expectedRow =
      case PlacedPiece 'Pawn'
pawn.color of
        Color
White -> Int
4
        Color
Black -> Int
3
    lastMove :: Command -> Maybe (Position, Position, Some Piece)
lastMove = \case
      Move Position
dst (Some (PlacedPiece Position
src Piece t
movedPiece)) ->
        forall a. a -> Maybe a
Just (Position
src, Position
dst, forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some Piece t
movedPiece)
      Sequence Command
cmd Command
_ ->
        Command -> Maybe (Position, Position, Some Piece)
lastMove Command
cmd
      Atomic Command
cmd ->
        Command -> Maybe (Position, Position, Some Piece)
lastMove Command
cmd
      Command
_ ->
        forall a. Maybe a
Nothing
  in do
    Update
update <- Game
game.lastUpdate
    (Position
src, Position
dst, Some Piece t
enemy) <- Command -> Maybe (Position, Position, Some Piece)
lastMove Update
update.command
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard
      -- the pawn must be in the correct row
       forall a b. (a -> b) -> a -> b
$ PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Int
expectedRow
      -- the previous move of the enemy must include a pawn
      Bool -> Bool -> Bool
&& forall (t :: PieceType') (a :: PieceType').
PieceType t -> Piece a -> Bool
isOfType PieceType 'Pawn'
Pawn Piece t
enemy
      -- the enemy's pawn must have ended its move next to the pawn
      Bool -> Bool -> Bool
&& PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Position
dst.row
      Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (PlacedPiece 'Pawn'
pawn.position.column forall a. Num a => a -> a -> a
- Position
dst.column) forall a. Eq a => a -> a -> Bool
== Int
1
      -- the enemy's pawn must have moved two fields
      Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs (Position
src.row forall a. Num a => a -> a -> a
- Position
dst.row) forall a. Eq a => a -> a -> Bool
== Int
2
    let
      newPosition :: Position
newPosition =
        Int -> Int -> Position
boundedPosition
          ( (Position
src.row forall a. Num a => a -> a -> a
+ Position
dst.row) forall a. Integral a => a -> a -> a
`div` Int
2 )
          ( Position
dst.column )
    forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall (t :: PieceType'). PlacedPiece t -> Command
destroy (forall (t :: PieceType'). Position -> Piece t -> PlacedPiece t
PlacedPiece Position
dst Piece t
enemy), forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
newPosition PlacedPiece 'Pawn'
pawn]

promotions :: PlacedPiece Pawn' -> [Command]
promotions :: PlacedPiece 'Pawn' -> [Command]
promotions PlacedPiece 'Pawn'
pawn = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$
    ( PlacedPiece 'Pawn'
pawn.color forall a. Eq a => a -> a -> Bool
== Color
White Bool -> Bool -> Bool
&& PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Int
7 ) Bool -> Bool -> Bool
||
    ( PlacedPiece 'Pawn'
pawn.color forall a. Eq a => a -> a -> Bool
== Color
Black Bool -> Bool -> Bool
&& PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Int
0 )
  [  forall (a :: PieceType') (b :: PieceType').
PlacedPiece a -> Piece b -> Command
promote PlacedPiece 'Pawn'
pawn (forall (t :: PieceType'). PieceType t -> Color -> Piece t
Piece PieceType 'Queen'
Queen  PlacedPiece 'Pawn'
pawn.color)
   , forall (a :: PieceType') (b :: PieceType').
PlacedPiece a -> Piece b -> Command
promote PlacedPiece 'Pawn'
pawn (forall (t :: PieceType'). PieceType t -> Color -> Piece t
Piece PieceType 'Rook'
Rook   PlacedPiece 'Pawn'
pawn.color)
   , forall (a :: PieceType') (b :: PieceType').
PlacedPiece a -> Piece b -> Command
promote PlacedPiece 'Pawn'
pawn (forall (t :: PieceType'). PieceType t -> Color -> Piece t
Piece PieceType 'Bishop'
Bishop PlacedPiece 'Pawn'
pawn.color)
   , forall (a :: PieceType') (b :: PieceType').
PlacedPiece a -> Piece b -> Command
promote PlacedPiece 'Pawn'
pawn (forall (t :: PieceType'). PieceType t -> Color -> Piece t
Piece PieceType 'Knight'
Knight PlacedPiece 'Pawn'
pawn.color) ]

direction :: PlacedPiece Pawn' -> Direction
direction :: PlacedPiece 'Pawn' -> Direction
direction PlacedPiece 'Pawn'
pawn =
  case PlacedPiece 'Pawn'
pawn.color of
    Color
White -> Direction
up
    Color
Black -> Direction
down

maybePromote :: Position -> PlacedPiece Pawn' -> Command -> [Command]
maybePromote :: Position -> PlacedPiece 'Pawn' -> Command -> [Command]
maybePromote Position
position PlacedPiece 'Pawn'
pawn Command
moveCmd =
  case PlacedPiece 'Pawn' -> [Command]
promotions (PlacedPiece 'Pawn'
pawn {$sel:position:PlacedPiece :: Position
position = Position
position}) of
    [] -> [Command
moveCmd]
    [Command]
ps -> [[Command
moveCmd, Command
p] | Command
p <- [Command]
ps]