{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
module Chess.Rulebook.Standard.Movement.Pawn
( movements
, oneStep
, twoSteps
, capture
, enPassant
) where
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))
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)
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)
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)
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]
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
forall a b. (a -> b) -> a -> b
$ PlacedPiece 'Pawn'
pawn.position.row forall a. Eq a => a -> a -> Bool
== Int
expectedRow
Bool -> Bool -> Bool
&& forall (t :: PieceType') (a :: PieceType').
PieceType t -> Piece a -> Bool
isOfType PieceType 'Pawn'
Pawn Piece t
enemy
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
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]