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

-- base
import Data.Either (rights)

import Chess.Board                      (piecesOf)
import Chess.Game                       (Game(activePlayer, board, passivePlayer), execute)
import Chess.Game.Status                (Status(..))
import Chess.Player                     (Player(color))
import Chess.Rulebook.Standard.Check    (checked)
import Chess.Rulebook.Standard.Movement (movements)
import Chess.Some                       (Some(Some))

-- | Determines the status of a chess game, according to the standard rulebook.
status :: Game -> Status
status :: Game -> Status
status Game
game =
  let
    activeColor :: Color
activeColor   = Game
game.activePlayer.color
    activePieces :: [Some PlacedPiece]
activePieces  = Color -> Board -> [Some PlacedPiece]
piecesOf Color
activeColor Game
game.board
    isChecked :: Bool
isChecked     = Player -> Board -> Bool
checked Game
game.activePlayer Game
game.board
    possibleMoves :: [Command]
possibleMoves = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Some PlacedPiece t
piece) -> forall (t :: PieceType'). PlacedPiece t -> Game -> [Command]
movements PlacedPiece t
piece Game
game) [Some PlacedPiece]
activePieces
    futures :: [Game]
futures       = forall a b. [Either a b] -> [b]
rights forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip Command -> Game -> Either ChessException Game
execute Game
game) [Command]
possibleMoves
    hasMoves :: Bool
hasMoves      = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Player -> Board -> Bool
checked Game
game.activePlayer forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.board)) [Game]
futures
  in if
    | Bool
isChecked Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasMoves     -> Player -> Status
Win Game
game.passivePlayer
    | Bool -> Bool
not Bool
isChecked Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasMoves -> Status
Draw
    | Bool
otherwise                     -> Player -> Status
Turn Game
game.activePlayer