{-# LANGUAGE OverloadedLists #-}
module Chess.Game
(
Game(..)
, Update(..)
, execute
, history
, spawnCommands
, 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))
data Update = Update
{ Update -> Game
game :: Game
, Update -> Command
command :: Command
}
data Game = Game
{ Game -> Board
board :: Board
, Game -> Player
activePlayer :: Player
, Game -> Player
passivePlayer :: Player
, Game -> Maybe Update
lastUpdate :: Maybe Update
}
execute :: Command -> Game -> Either ChessException Game
execute :: Command -> Game -> Either ChessException Game
execute Command
command Game
game =
case Command
command of
Command
EndTurn ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Game
game
{ $sel:activePlayer:Game :: Player
activePlayer = Game
game.passivePlayer
, $sel:passivePlayer:Game :: Player
passivePlayer = Game
game.activePlayer
}
Move Position
dst (Some PlacedPiece t
placed) -> do
Board
tempBoard <- forall (t :: PieceType').
PlacedPiece t -> Board -> Either ChessException Board
remove PlacedPiece t
placed Game
game.board
Board
newBoard <- forall (t :: PieceType').
Position -> Piece t -> Board -> Either ChessException Board
place Position
dst PlacedPiece t
placed.piece Board
tempBoard
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
game { $sel:board:Game :: Board
board = Board
newBoard }
Destroy (Some PlacedPiece t
piece) -> do
Board
newBoard <- forall (t :: PieceType').
PlacedPiece t -> Board -> Either ChessException Board
remove PlacedPiece t
piece Game
game.board
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
game { $sel:board:Game :: Board
board = Board
newBoard }
Spawn Position
position (Some Piece t
piece) -> do
Board
newBoard <- forall (t :: PieceType').
Position -> Piece t -> Board -> Either ChessException Board
place Position
position Piece t
piece Game
game.board
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
game { $sel:board:Game :: Board
board = Board
newBoard }
Sequence Command
cmd1 Command
cmd2 ->
Command -> Game -> Either ChessException Game
execute Command
cmd1 Game
game forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Command -> Game -> Either ChessException Game
execute Command
cmd2
Promote piece :: Some PlacedPiece
piece@(Some PlacedPiece t
old) Some Piece
new ->
Command -> Game -> Either ChessException Game
execute [Some PlacedPiece -> Command
Destroy Some PlacedPiece
piece, Position -> Some Piece -> Command
Spawn PlacedPiece t
old.position Some Piece
new] Game
game
Atomic Command
cmd -> do
Game
newGame <- Command -> Game -> Either ChessException Game
execute Command
cmd Game
game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
newGame { $sel:lastUpdate:Game :: Maybe Update
lastUpdate = forall a. a -> Maybe a
Just (Game -> Command -> Update
Update Game
game Command
command) }
history :: Game -> [Update]
history :: Game -> [Update]
history Game
game =
case Game
game.lastUpdate of
Just Update
update -> Update
update forall a. a -> [a] -> [a]
: Game -> [Update]
history Update
update.game
Maybe Update
Nothing -> []
spawnCommands :: Game -> [Command]
spawnCommands :: Game -> [Command]
spawnCommands Game
game =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Board -> [Some PlacedPiece]
pieces Game
game.board) forall a b. (a -> b) -> a -> b
$ \(Some PlacedPiece t
placedPiece) ->
forall (t :: PieceType'). Position -> Piece t -> Command
spawn PlacedPiece t
placedPiece.position PlacedPiece t
placedPiece.piece