{-# 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 (Command -> Command -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Eq Command
Command -> Command -> Bool
Command -> Command -> Ordering
Command -> Command -> Command
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Command -> Command -> Command
$cmin :: Command -> Command -> Command
max :: Command -> Command -> Command
$cmax :: Command -> Command -> Command
>= :: Command -> Command -> Bool
$c>= :: Command -> Command -> Bool
> :: Command -> Command -> Bool
$c> :: Command -> Command -> Bool
<= :: Command -> Command -> Bool
$c<= :: Command -> Command -> Bool
< :: Command -> Command -> Bool
$c< :: Command -> Command -> Bool
compare :: Command -> Command -> Ordering
$ccompare :: Command -> Command -> Ordering
Ord, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

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

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

-- | Smart constructor for 'Move'.
move :: Position -> PlacedPiece t -> Command
move :: forall (t :: PieceType'). Position -> PlacedPiece t -> Command
move Position
position = Position -> Some PlacedPiece -> Command
Move Position
position forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some

-- | Smart constructor for 'Destroy'.
destroy :: PlacedPiece t -> Command
destroy :: forall (t :: PieceType'). PlacedPiece t -> Command
destroy = Some PlacedPiece -> Command
Destroy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some

-- | Smart constructor for 'Spawn'.
spawn :: Position -> Piece t -> Command
spawn :: forall (t :: PieceType'). Position -> Piece t -> Command
spawn Position
position = Position -> Some Piece -> Command
Spawn Position
position forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some

-- | Smart constructor for 'Promote'.
promote :: PlacedPiece a -> Piece b -> Command
promote :: forall (a :: PieceType') (b :: PieceType').
PlacedPiece a -> Piece b -> Command
promote PlacedPiece a
placed Piece b
piece = Some PlacedPiece -> Some Piece -> Command
Promote (forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some PlacedPiece a
placed) (forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some Piece b
piece)

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

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

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