{-# LANGUAGE MultiWayIf #-}
module Chess.Rulebook.Standard.Status where
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))
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