Command.hs

{-# LANGUAGE LambdaCase   #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Game.Command
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Types and functions for commands that can change chess game states.
-----------------------------------------------------------------------------
module Chess.Game.Command where

-- base
import GHC.Exts       (IsList(Item, fromList, toList))
import Prelude hiding (sequence)

import Chess.Board.PlacedPiece (PlacedPiece(..))
import Chess.Board.Position    (Position)
import Chess.Piece             (Piece)
import Chess.Some              (Some(Some))

-- | A command can be applied to a chess game state in order to obtain a new game state.
data Command
  = EndTurn
    -- ^ Ends the turn of the active player.
  | Move Position (Some PlacedPiece)
    -- ^ Moves a placed piece to the specified position.
  | Destroy (Some PlacedPiece)
    -- ^ Removes a placed piece.
  | Spawn Position (Some Piece)
    -- ^ Creates a chess piece on the specified position.
  | Promote (Some PlacedPiece) (Some Piece)
    -- ^ Converts a chess piece into another piece.
  | Sequence Command Command
    -- ^ Represents the consecutive execution of two commands.
  | Atomic Command
    -- ^ Denotes that a command and its sub-commands belong together and should
    -- be treated as single command (e.g., when recording the history of a chess game).
  deriving (Eq, Ord, Show)

instance IsList Command where
  type Item Command = Command
  
  fromList [cmd]    = cmd
  fromList (cmd:cs) = Sequence cmd (fromList cs)
  fromList []       = errorWithoutStackTrace "Command.fromList: empty list"
  
  toList (Sequence cmd1 cmd2) = cmd1 : toList cmd2
  toList cmd                  = [cmd]

-- | Smart constructor for 'EndTurn'.
endTurn :: Command
endTurn = EndTurn

-- | Smart constructor for 'Move'.
move :: Position -> PlacedPiece t -> Command
move position = Move position . Some

-- | Smart constructor for 'Destroy'.
destroy :: PlacedPiece t -> Command
destroy = Destroy . Some

-- | Smart constructor for 'Spawn'.
spawn :: Position -> Piece t -> Command
spawn position = Spawn position . Some

-- | Smart constructor for 'Promote'.
promote :: PlacedPiece a -> Piece b -> Command
promote placed piece = Promote (Some placed) (Some piece)

-- | Smart constructor for 'Sequence'.
sequence :: Command -> Command -> Command
sequence = Sequence

-- | Smart constructor for 'Atomic'.
atomic :: Command -> Command
atomic = Atomic

-- | Produces a command that has the opposite effect of the specified command.
undo :: Command -> Command
undo = \case
  EndTurn ->
    EndTurn
  Move dst (Some (PlacedPiece src piece)) ->
    move src (PlacedPiece dst piece)
  Destroy (Some placed) ->
    spawn placed.position placed.piece
  Spawn position (Some piece) ->
    destroy (PlacedPiece position piece)
  Promote (Some (PlacedPiece position old)) (Some new) ->
    promote (PlacedPiece position new) old
  Sequence cmd1 cmd2 ->
    sequence (undo cmd2) (undo cmd1)
  Atomic cmd ->
    atomic (undo cmd)