Chess.hs

module Lib
    (
    ) where


import Prelude
import Control.Monad.Reader
import Data.Matrix


data Color = White | Black deriving (Eq, Show)

other :: Color -> Color
other White = Black
other Black = White


type Field = (Int, Int)

data GameState = GameState {
    whosTurn :: Color,
    board :: Board
}


type Board = Matrix (Maybe Piece)


-- class Piece p where
--     possibleMoves :: p -> GameState -> [Field]
--     ident :: p -> Int
--     color :: p -> Color


data Piece = Piece {
    indent :: Int,
    color :: Color,
    isKing :: Bool
}


-- | TODO Reader monad looks great, but I seem to lack the abstractions
successors :: GameState -> [GameState]
successors = undefined
-- successors = do
--     color <- whosTurn
--     pieces <- allPiecesOfColor color
--     gs <- ask
--     return $ concatMap


successorsFromPiece :: Piece -> GameState -> [GameState]
successorsFromPiece piece = do
    pots <- potentialMoves piece
    gs <- ask
    let potentialSuccessors = map (\field -> movePieceToField piece field gs) pots  -- TODO how to make it prettier?
    myColor <- reader whosTurn
    return $ filter (not . isCheck myColor) potentialSuccessors


-- | UNDEF
movePieceToField :: Piece -> Field -> GameState -> GameState
movePieceToField = undefined


-- | UNDEF
potentialMoves :: Piece -> GameState -> [Field]
potentialMoves = undefined


isCheck :: Color -> GameState -> Bool
isCheck myColor = do
    let yourColor = other myColor
    myKing <- kingOfColor myColor
    yourPieces <- allPiecesOfColor yourColor
    gs <- ask
    return $ any (\yourPiece -> threatens yourPiece myKing gs) yourPieces


isMate :: GameState -> Bool
isMate = do
    color <- whosTurn
    check <- isCheck color
    suc <- successors
    return $ check && null suc


-- | UNDEF
allPiecesOfColor :: Color -> GameState -> [Piece]
allPiecesOfColor = undefined


-- | UNDEF
position :: Piece -> GameState -> Field
position = undefined


-- | UNDEF
kingOfColor :: Color -> GameState -> Piece
kingOfColor = undefined


threatens :: Piece -> Piece -> GameState -> Bool
threatens p1 p2 = do
    pos <- position p2
    pots <- potentialMoves p1
    return $ pos `elem` pots