-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Board
-- 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 boards.
-----------------------------------------------------------------------------
module Chess.Board
  ( -- * Representing Boards
    Board
  , empty
    -- * Manipulating Boards
  , place
  , replace
  , remove
    -- * Querying Boards
  , lookup
  , isOccupied
  , pieces
  , piecesOf
  -- * Re-exports
  , module Chess.Board.Direction
  , module Chess.Board.PlacedPiece
  , module Chess.Board.Position
  ) where

-- base
import Control.Applicative qualified as A
import Data.Maybe          (isJust)
import Prelude      hiding (lookup)

-- containers
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))

-- | Represents a chess board.
newtype Board = Board { Board -> Map Position (Some Piece)
pieces :: M.Map Position (Some Piece) }

-- | An empty chess board, i.e. a board with no placed pieces.
empty :: Board
empty :: Board
empty = Map Position (Some Piece) -> Board
Board forall k a. Map k a
M.empty

-- | Introduces a new chess piece to the chess board at a specific position.
place
  :: Position
  -- ^ The position of the newly introduced chess piece.
  -> Piece t
  -- ^ The newly introduced chess piece.
  -> Board
  -- ^ The original chess board.
  -> Either ChessException Board
  -- ^ The new chess board, if the specified position has not been occupied.
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

-- | Introduces a new chess piece to the chess board at a specific position.
replace
  :: Position
  -- ^ The position of the newly introduced chess piece.
  -> Piece t
  -- ^ The newly introduced chess piece.
  -> Board
  -- ^ The original chess board.
  -> Board
  -- ^ The new chess board. If the specified position has been occupied, the piece is replaced.
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)

-- | Removes a chess piece from the chess board at a given position.
remove
  :: PlacedPiece t
  -- ^ The position of the chess piece to be removed.
  -> Board
  -- ^ The original chess board.
  -> Either ChessException Board
  -- ^ The new chess board, if the specified position was indeed occupied by the piece.
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)

-- | Gets a chess piece at a specific position of the chess board.
lookup
  :: A.Alternative f
  => Position
  -- ^ The position to look for a chess piece.
  -> Board
  -- ^ The board used for the lookup.
  -> f (Some PlacedPiece)
  -- ^ The chess piece, if the specified position was indeed occupied by it.
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

-- | Checks if a specified position of the chess board is occupied by a chess piece.
isOccupied
  :: Position -- ^ The position to be checked for occupation.
  -> Board    -- ^ The board whose position is checked for occupation.
  -> Bool     -- ^ True if the specified position is occupied, or else false.
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

-- | Gets all chess pieces that are currently on the chess board.
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)

-- | Gets all chess pieces of a given color that are currently on the chess board.
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)