module Chess.Board
(
Board
, empty
, place
, replace
, remove
, lookup
, isOccupied
, pieces
, piecesOf
, module Chess.Board.Direction
, module Chess.Board.PlacedPiece
, module Chess.Board.Position
) where
import Control.Applicative qualified as A
import Data.Maybe (isJust)
import Prelude hiding (lookup)
import Data.Map.Strict qualified as M
import Chess.Board.Direction
import Chess.Board.PlacedPiece
import Chess.Board.Position
import Chess.Color (Color)
import Chess.Exception (ChessException, fieldOccupied, pieceMissing, unexpectedPiece)
import Chess.Piece (Piece(color), same)
import Chess.Some (Some(Some))
newtype Board = Board { Board -> Map Position (Some Piece)
pieces :: M.Map Position (Some Piece) }
empty :: Board
empty :: Board
empty = Map Position (Some Piece) -> Board
Board forall k a. Map k a
M.empty
place
:: Position
-> Piece t
-> Board
-> Either ChessException Board
place :: forall (t :: PieceType').
Position -> Piece t -> Board -> Either ChessException Board
place Position
position Piece t
piece Board
board =
let
(Maybe (Some Piece)
maybeOldPiece, Map Position (Some Piece)
newPieces) =
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
M.insertLookupWithKey
( \Position
_key Some Piece
new Some Piece
_old -> Some Piece
new )
( Position
position )
( forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some Piece t
piece )
( Board
board.pieces )
in
case Maybe (Some Piece)
maybeOldPiece of
Just (Some Piece t
oldPiece) ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (t :: PieceType'). PlacedPiece t -> ChessException
fieldOccupied (forall (t :: PieceType'). Position -> Piece t -> PlacedPiece t
PlacedPiece Position
position Piece t
oldPiece)
Maybe (Some Piece)
Nothing ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Map Position (Some Piece) -> Board
Board Map Position (Some Piece)
newPieces
replace
:: Position
-> Piece t
-> Board
-> Board
replace :: forall (t :: PieceType'). Position -> Piece t -> Board -> Board
replace Position
position Piece t
piece (Board Map Position (Some Piece)
oldPieces) =
Map Position (Some Piece) -> Board
Board (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Position
position (forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some Piece t
piece) Map Position (Some Piece)
oldPieces)
remove
:: PlacedPiece t
-> Board
-> Either ChessException Board
remove :: forall (t :: PieceType').
PlacedPiece t -> Board -> Either ChessException Board
remove placed :: PlacedPiece t
placed@PlacedPiece{Position
$sel:position:PlacedPiece :: forall (t :: PieceType'). PlacedPiece t -> Position
position :: Position
position, Piece t
$sel:piece:PlacedPiece :: forall (t :: PieceType'). PlacedPiece t -> Piece t
piece :: Piece t
piece} Board
board =
let
(Maybe (Some Piece)
maybeOldPiece, Map Position (Some Piece)
newPieces) =
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey
( \Position
_ Some Piece
_ -> forall a. Maybe a
Nothing )
( Position
position )
( Board
board.pieces )
in
case Maybe (Some Piece)
maybeOldPiece of
Maybe (Some Piece)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (t :: PieceType'). PlacedPiece t -> ChessException
pieceMissing PlacedPiece t
placed
Just (Some Piece t
oldPiece)
| forall (a :: PieceType') (b :: PieceType').
Piece a -> Piece b -> Bool
same Piece t
oldPiece Piece t
piece -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Map Position (Some Piece) -> Board
Board Map Position (Some Piece)
newPieces
| Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (t :: PieceType'). PlacedPiece t -> ChessException
unexpectedPiece (forall (t :: PieceType'). Position -> Piece t -> PlacedPiece t
PlacedPiece Position
position Piece t
oldPiece)
lookup
:: A.Alternative f
=> Position
-> Board
-> f (Some PlacedPiece)
lookup :: forall (f :: * -> *).
Alternative f =>
Position -> Board -> f (Some PlacedPiece)
lookup Position
position Board
board =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Position
position Board
board.pieces of
Just (Some Piece t
piece) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: PieceType'). Position -> Piece t -> Some PlacedPiece
placedPiece Position
position Piece t
piece
Maybe (Some Piece)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
A.empty
isOccupied
:: Position
-> Board
-> Bool
isOccupied :: Position -> Board -> Bool
isOccupied Position
position =
forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Alternative f =>
Position -> Board -> f (Some PlacedPiece)
lookup Position
position
pieces :: Board -> [Some PlacedPiece]
pieces :: Board -> [Some PlacedPiece]
pieces
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Position
position, Some Piece t
piece) -> forall (t :: PieceType'). Position -> Piece t -> Some PlacedPiece
placedPiece Position
position Piece t
piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.pieces)
piecesOf :: Color -> Board -> [Some PlacedPiece]
piecesOf :: Color -> Board -> [Some PlacedPiece]
piecesOf Color
color
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Position
position, Some Piece t
piece) -> forall (t :: PieceType'). Position -> Piece t -> Some PlacedPiece
placedPiece Position
position Piece t
piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(Position
_, Some Piece t
piece) -> Piece t
piece.color forall a. Eq a => a -> a -> Bool
== Color
color)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.pieces)