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

-- base
import Prelude hiding (lookup)

import Chess.Board             (Board, lookup)
import Chess.Board.Direction   (Direction(..), diagonals, jumps, orthogonals, principals)
import Chess.Board.PlacedPiece (PlacedPiece(..))
import Chess.Board.Position    (Position, offset)
import Chess.Color             (Color(White))
import Chess.Game.Command      (Command, move, destroy)
import Chess.Piece             (PieceType(..))
import Chess.Some              (Some(Some))

-- | Determines the positions threatened by a given chess piece.
threats :: PlacedPiece t -> Board -> [Position]
threats :: forall (t :: PieceType'). PlacedPiece t -> Board -> [Position]
threats PlacedPiece t
piece Board
board =
  case PlacedPiece t
piece.type' of
    PieceType t
Pawn   -> [Direction] -> Int -> [Position]
threat [Direction]
pawnDirections Int
1
    PieceType t
Knight -> [Direction] -> Int -> [Position]
threat [Direction]
jumps Int
1
    PieceType t
Bishop -> [Direction] -> Int -> [Position]
threat [Direction]
diagonals forall a. Bounded a => a
maxBound
    PieceType t
Rook   -> [Direction] -> Int -> [Position]
threat [Direction]
orthogonals forall a. Bounded a => a
maxBound
    PieceType t
Queen  -> [Direction] -> Int -> [Position]
threat [Direction]
principals forall a. Bounded a => a
maxBound
    PieceType t
King   -> [Direction] -> Int -> [Position]
threat [Direction]
principals Int
1
  where
    threat :: [Direction] -> Int -> [Position]
threat = forall (t :: PieceType').
PlacedPiece t -> Board -> [Direction] -> Int -> [Position]
reach PlacedPiece t
piece Board
board
    pawnDelta :: Int
pawnDelta = if PlacedPiece t
piece.color forall a. Eq a => a -> a -> Bool
== Color
White then Int
1 else (-Int
1)
    pawnDirections :: [Direction]
pawnDirections = forall a. (a -> Bool) -> [a] -> [a]
filter (\Direction
d -> Direction
d.rowDelta forall a. Eq a => a -> a -> Bool
== Int
pawnDelta) [Direction]
diagonals

-- | Determines all possible threat-based movements (including captures) for a
-- given chess piece.
threatCommands :: PlacedPiece t -> Board -> [Command]
threatCommands :: forall (t :: PieceType'). PlacedPiece t -> Board -> [Command]
threatCommands PlacedPiece t
piece Board
board = do
  Position
target <- forall (t :: PieceType'). PlacedPiece t -> Board -> [Position]
threats PlacedPiece t
piece Board
board
  case forall (f :: * -> *).
Alternative f =>
Position -> Board -> f (Some PlacedPiece)
lookup Position
target Board
board of
    Maybe (Some PlacedPiece)
Nothing ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
target PlacedPiece t
piece)
    Just (Some PlacedPiece t
enemy) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall (t :: PieceType'). PlacedPiece t -> Command
destroy PlacedPiece t
enemy, forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
target PlacedPiece t
piece]

-- | Starting at a specified position, provides a list of all the positions
--   that are reachable by a chess piece in the given directions.
reach
  :: PlacedPiece t -- ^ The analyzed chess piece.
  -> Board         -- ^ The current chess board state.
  -> [Direction]   -- ^ The directions to iterate, beginning by the starting position.
  -> Int           -- ^ The maximum count of steps to take in a specific direction.
  -> [Position]    -- ^ A list of all the reachable positions.
reach :: forall (t :: PieceType').
PlacedPiece t -> Board -> [Direction] -> Int -> [Position]
reach PlacedPiece t
piece Board
board [Direction]
directions Int
maxSteps = do
  Direction
direction <- [Direction]
directions
  [Position] -> [Position]
takeUntilPiece
    forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
maxSteps
    forall a b. (a -> b) -> a -> b
$ forall {t}. (t -> Maybe t) -> t -> [t]
collect (forall (f :: * -> *).
Alternative f =>
Direction -> Position -> f Position
offset Direction
direction) PlacedPiece t
piece.position
  where
    -- takeUntilPiece iterates until a friend or enemy piece is hit
    takeUntilPiece :: [Position] -> [Position]
takeUntilPiece [] = []
    takeUntilPiece (Position
p:[Position]
ps) =
      case forall (f :: * -> *).
Alternative f =>
Position -> Board -> f (Some PlacedPiece)
lookup Position
p Board
board of
        Maybe (Some PlacedPiece)
Nothing -> Position
p forall a. a -> [a] -> [a]
: [Position] -> [Position]
takeUntilPiece [Position]
ps
        Just (Some PlacedPiece t
other)
          | PlacedPiece t
piece.color forall a. Eq a => a -> a -> Bool
== PlacedPiece t
other.color -> []
          | Bool
otherwise                  -> [Position
p]
    -- collect is catMaybes, but only until the first Nothing
    collect :: (t -> Maybe t) -> t -> [t]
collect t -> Maybe t
f t
start = Maybe t -> [t]
go (t -> Maybe t
f t
start)
      where
        go :: Maybe t -> [t]
go (Just t
p) = t
p forall a. a -> [a] -> [a]
: Maybe t -> [t]
go (t -> Maybe t
f t
p)
        go Maybe t
Nothing  = []