-- |
-- Module      :  Chess
-- Copyright   :  Miika-Petteri Matikainen 2014
-- License     :  GPL-2
--
-- Maintainer  :  miikapetteri@gmail.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Simple chess library for implementing chess games.
module Chess (
              Chess.Internal.Board.Board,
              Chess.Internal.Board.Coordinates,
              Chess.Internal.Board.Square(..),
              Chess.Internal.Move.GameState,
              Chess.Internal.Move.currentPlayer,
              Chess.Internal.Piece.Color(..),
              Chess.Internal.Piece.Piece(..),
              Chess.Internal.Piece.PieceType(..),
              Chess.Internal.Move.Move,
              board,
              fullMoveNumber,
              isCheckmate,
              isDraw,
              isLegalMove,
              isStalemate,
              move,
              newGame,
              pieceAt,
              winner,
              legalMoves,
              applyMove,
              ) where

import Chess.Internal.Board
import Chess.Internal.Move
import Chess.Internal.Piece
import qualified Chess.Internal.Game as G
import qualified Chess.Internal.Notation as N

-- | Has the game ended in checkmate
isCheckmate :: GameState -> Bool
isCheckmate :: GameState -> Bool
isCheckmate = GameState -> Bool
G.isCheckmate

-- | Has the game ended in stalemate
isStalemate :: GameState -> Bool
isStalemate :: GameState -> Bool
isStalemate = GameState -> Bool
G.isStalemate

-- | Is the game draw? I.e. is the game stalemate or is the game draw by
-- insufficient material.
isDraw :: GameState -> Bool
isDraw :: GameState -> Bool
isDraw = GameState -> Bool
G.isDraw

-- | Returns the winner of the game if any
winner :: GameState -> Maybe Color
winner :: GameState -> Maybe Color
winner = GameState -> Maybe Color
G.getWinner

-- | Is the given move legal. The only supported move format at the moment
-- is coordinate notation.
isLegalMove :: GameState
            -> String    -- ^ Move in coordinate notation. E.g. "e2-e4" or "b1-c3"
            -> Bool
isLegalMove :: GameState -> String -> Bool
isLegalMove GameState
game String
moveStr = case GameState -> String -> Maybe Move
N.parseMove GameState
game String
moveStr of
                                   Just Move
m -> Move
m Move -> [Move] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` GameState -> [Move]
generateAllMoves GameState
game
                                   Maybe Move
Nothing -> Bool
False

-- | Make a move. The only supported move format at the moment is coordinate
-- notation.
move :: GameState
     -> String          -- ^ Move in coordinate notation. E.g. "e2-e4" or "b1-c3"
     -> Maybe GameState
move :: GameState -> String -> Maybe GameState
move GameState
game String
moveStr = do Move
m <- GameState -> String -> Maybe Move
N.parseMove GameState
game String
moveStr
                       GameState -> Move -> Maybe GameState
applyMove GameState
game Move
m

-- | Current board state in the game
board :: GameState -> Board
board :: GameState -> Board
board = GameState -> Board
stateBoard

-- | Get initial game state
newGame :: GameState
newGame :: GameState
newGame = GameState
initialState

-- | Get the piece at the given coordinate
pieceAt :: Board
        -> String      -- ^ Square coordinate. E.g. "e4"
        -> Maybe Piece
pieceAt :: Board -> String -> Maybe Piece
pieceAt Board
b String
coordinateStr = do Coordinates
coords <- String -> Maybe Coordinates
parseCoordinate String
coordinateStr
                             Board -> Coordinates -> Maybe Piece
getPiece Board
b Coordinates
coords

-- | Full move number. Incremented after black's move.
fullMoveNumber :: GameState -> Integer
fullMoveNumber :: GameState -> Integer
fullMoveNumber = GameState -> Integer
moveNumber

-- | Get all legal moves in the position
legalMoves :: GameState -> [Move]
legalMoves :: GameState -> [Move]
legalMoves = GameState -> [Move]
generateAllMoves

-- | Apply a move
applyMove :: GameState -> Move -> Maybe GameState
applyMove :: GameState -> Move -> Maybe GameState
applyMove GameState
game Move
m = case GameState -> Move -> Either MoveError GameState
G.applyMove GameState
game Move
m of
                        Left MoveError
_ -> Maybe GameState
forall a. Maybe a
Nothing
                        Right GameState
game' -> GameState -> Maybe GameState
forall a. a -> Maybe a
Just GameState
game'