Game.hs

{-# LANGUAGE OverloadedLists #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Game
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Types and functions to create, manipulate and query chess game states.
-----------------------------------------------------------------------------
module Chess.Game
  ( -- * Representing Games
    Game(..)
  , Update(..)
    -- * Manipulating Games
  , execute
    -- * Querying Games
  , history
  , spawnCommands
    -- * Re-exports
  , module Chess.Game.Command
  , module Chess.Game.Status
  ) where

import Chess.Board             (Board, pieces, place, remove)
import Chess.Board.PlacedPiece (PlacedPiece(..))
import Chess.Exception         (ChessException)
import Chess.Game.Command
import Chess.Game.Status
import Chess.Player            (Player)
import Chess.Some              (Some(Some))

-- | Represents an update of a chess game state.
data Update = Update
  { game :: Game
    -- ^ Represents the chess game state before or after executing the corresponding command,
    -- depending on the context.
  , command :: Command
    -- ^ Represents the command that is involved in the game state update.
  }

-- | Represents a chess game state.
data Game = Game
  { board :: Board
    -- ^ The state of the chess board.
  , activePlayer :: Player
    -- ^ The player who is currently playing.
  , passivePlayer :: Player
    -- ^ The player who is currently waiting.
  , lastUpdate :: Maybe Update
    -- ^ The last update which led to this game state.
  }

-- | Executes a command on a game state in order to obtain a new game state.
execute :: Command -> Game -> Either ChessException Game
execute command game =
  case command of
    EndTurn ->
      pure
        game
          { activePlayer  = game.passivePlayer
          , passivePlayer = game.activePlayer
          }
    Move dst (Some placed) -> do
      tempBoard <- remove placed game.board
      newBoard <- place dst placed.piece tempBoard
      pure game { board = newBoard }
    Destroy (Some piece) -> do
      newBoard <- remove piece game.board
      pure game { board = newBoard }
    Spawn position (Some piece) -> do
      newBoard <- place position piece game.board
      pure game { board = newBoard }
    Sequence cmd1 cmd2 ->
      execute cmd1 game >>= execute cmd2
    Promote piece@(Some old) new ->
      execute [Destroy piece, Spawn old.position new] game
    Atomic cmd -> do
      newGame <- execute cmd game
      pure newGame { lastUpdate = Just (Update game command) }

-- | Gets the history of updates that led to the specified game state.
-- The most recent update is at the head of the list.
history :: Game -> [Update]
history game =
  case game.lastUpdate of
    Just update -> update : history update.game
    Nothing     -> []

-- | Gets a list of 'Spawn' commands which can be used to reconstruct
-- the board of the specified game state.
spawnCommands :: Game -> [Command]
spawnCommands game =
  flip fmap (pieces game.board) $ \(Some placedPiece) ->
    spawn placedPiece.position placedPiece.piece