-- | Bindings for Shiro's [chess bot tournament](https://github.com/shiro-nya/2025-chess-bot-tournament)
module Chess
  ( Bitboard,
    Board,
    Dir (..),
    Piece (..),
    PlayerColor (..),
    State (..),
    Move (..),
    moveDefault,
    -- * IO actions
    -- | For info on how to use IO actions, see [Haskell wiki](https://wiki.haskell.org/index.php?title=Introduction_to_Haskell_IO/Introduction_to_IO_actions).
    getBoard,
    opponentMove,
    submitMove,
    getTimeMillis,
    getOpponentTimeMillis,
    getElapsedTimeMillis,
    -- * Board functions
    legalMoves,
    nextTurnColor,
    isWhiteTurn,
    isBlackTurn,
    skipTurn,
    gameState,
    inCheck,
    inCheckmate,
    inDraw,
    canCastleKingside,
    canCastleQueenside,
    zobristKey,
    pushMove,
    popMove,
    fullMoves,
    halfMoves,
    bitboard,
    pieceFromIndex,
    pieceFromBitboard,
    colorFromIndex,
    colorFromBitboard,
    -- * Bitboard functions
    indexFromBitboard,
    bitboardFromIndex,
    showBitboard,
    bbSlide,
    bbFlood,
    bbBlocker,
    -- ** Bitboard function specializations
    -- | Specializations for individual directions, matching the C API.
    bbSlideN,
    bbSlideS,
    bbSlideE,
    bbSlideW,
    bbSlideNE,
    bbSlideNW,
    bbSlideSE,
    bbSlideSW,
    bbFloodN,
    bbFloodS,
    bbFloodE,
    bbFloodW,
    bbFloodNE,
    bbFloodNW,
    bbFloodSE,
    bbFloodSW,
    bbBlockerN,
    bbBlockerS,
    bbBlockerE,
    bbBlockerW,
    bbBlockerNE,
    bbBlockerNW,
    bbBlockerSE,
    bbBlockerSW,
  )
where

import Chess.Bindings
import Data.Bits (bit, countLeadingZeros, finiteBitSize, shiftL, shiftR, testBit, (.&.), (.|.))
import Data.Word (Word64)
import Foreign (ForeignPtr, Ptr, free, fromBool, malloc, newForeignPtr, peek, peekArray, toBool, withForeignPtr)
import System.IO.Unsafe (unsafePerformIO)

-- | A bitboard - an integer where each of the 64 bits represents a square of the board.
--   The bits usually encode the presence of a particular piece.
--   The least significant bit corresponds to a1, the 8th least significant bit corresponds to a8,
--   the most significant bit corresponds to h8.
type Bitboard = Word64

-- | A game of chess in a particular state.
newtype Board = Board (ForeignPtr C'Board)

-- | Directions, used for bitboard manipulation.
data Dir
  = N
  | NE
  | E
  | SE
  | S
  | SW
  | W
  | NW
  deriving (Dir -> Dir -> Bool
(Dir -> Dir -> Bool) -> (Dir -> Dir -> Bool) -> Eq Dir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dir -> Dir -> Bool
== :: Dir -> Dir -> Bool
$c/= :: Dir -> Dir -> Bool
/= :: Dir -> Dir -> Bool
Eq, Int -> Dir -> ShowS
[Dir] -> ShowS
Dir -> String
(Int -> Dir -> ShowS)
-> (Dir -> String) -> ([Dir] -> ShowS) -> Show Dir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dir -> ShowS
showsPrec :: Int -> Dir -> ShowS
$cshow :: Dir -> String
show :: Dir -> String
$cshowList :: [Dir] -> ShowS
showList :: [Dir] -> ShowS
Show, Int -> Dir
Dir -> Int
Dir -> [Dir]
Dir -> Dir
Dir -> Dir -> [Dir]
Dir -> Dir -> Dir -> [Dir]
(Dir -> Dir)
-> (Dir -> Dir)
-> (Int -> Dir)
-> (Dir -> Int)
-> (Dir -> [Dir])
-> (Dir -> Dir -> [Dir])
-> (Dir -> Dir -> [Dir])
-> (Dir -> Dir -> Dir -> [Dir])
-> Enum Dir
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Dir -> Dir
succ :: Dir -> Dir
$cpred :: Dir -> Dir
pred :: Dir -> Dir
$ctoEnum :: Int -> Dir
toEnum :: Int -> Dir
$cfromEnum :: Dir -> Int
fromEnum :: Dir -> Int
$cenumFrom :: Dir -> [Dir]
enumFrom :: Dir -> [Dir]
$cenumFromThen :: Dir -> Dir -> [Dir]
enumFromThen :: Dir -> Dir -> [Dir]
$cenumFromTo :: Dir -> Dir -> [Dir]
enumFromTo :: Dir -> Dir -> [Dir]
$cenumFromThenTo :: Dir -> Dir -> Dir -> [Dir]
enumFromThenTo :: Dir -> Dir -> Dir -> [Dir]
Enum, Dir
Dir -> Dir -> Bounded Dir
forall a. a -> a -> Bounded a
$cminBound :: Dir
minBound :: Dir
$cmaxBound :: Dir
maxBound :: Dir
Bounded)

-- | Chess piece types
data Piece
  = Pawn
  | Bishop
  | Knight
  | Rook
  | Queen
  | King
  deriving (Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
/= :: Piece -> Piece -> Bool
Eq, Int -> Piece -> ShowS
[Piece] -> ShowS
Piece -> String
(Int -> Piece -> ShowS)
-> (Piece -> String) -> ([Piece] -> ShowS) -> Show Piece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Piece -> ShowS
showsPrec :: Int -> Piece -> ShowS
$cshow :: Piece -> String
show :: Piece -> String
$cshowList :: [Piece] -> ShowS
showList :: [Piece] -> ShowS
Show, Int -> Piece
Piece -> Int
Piece -> [Piece]
Piece -> Piece
Piece -> Piece -> [Piece]
Piece -> Piece -> Piece -> [Piece]
(Piece -> Piece)
-> (Piece -> Piece)
-> (Int -> Piece)
-> (Piece -> Int)
-> (Piece -> [Piece])
-> (Piece -> Piece -> [Piece])
-> (Piece -> Piece -> [Piece])
-> (Piece -> Piece -> Piece -> [Piece])
-> Enum Piece
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Piece -> Piece
succ :: Piece -> Piece
$cpred :: Piece -> Piece
pred :: Piece -> Piece
$ctoEnum :: Int -> Piece
toEnum :: Int -> Piece
$cfromEnum :: Piece -> Int
fromEnum :: Piece -> Int
$cenumFrom :: Piece -> [Piece]
enumFrom :: Piece -> [Piece]
$cenumFromThen :: Piece -> Piece -> [Piece]
enumFromThen :: Piece -> Piece -> [Piece]
$cenumFromTo :: Piece -> Piece -> [Piece]
enumFromTo :: Piece -> Piece -> [Piece]
$cenumFromThenTo :: Piece -> Piece -> Piece -> [Piece]
enumFromThenTo :: Piece -> Piece -> Piece -> [Piece]
Enum, Piece
Piece -> Piece -> Bounded Piece
forall a. a -> a -> Bounded a
$cminBound :: Piece
minBound :: Piece
$cmaxBound :: Piece
maxBound :: Piece
Bounded, Eq Piece
Eq Piece =>
(Piece -> Piece -> Ordering)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Piece)
-> (Piece -> Piece -> Piece)
-> Ord Piece
Piece -> Piece -> Bool
Piece -> Piece -> Ordering
Piece -> Piece -> Piece
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Piece -> Piece -> Ordering
compare :: Piece -> Piece -> Ordering
$c< :: Piece -> Piece -> Bool
< :: Piece -> Piece -> Bool
$c<= :: Piece -> Piece -> Bool
<= :: Piece -> Piece -> Bool
$c> :: Piece -> Piece -> Bool
> :: Piece -> Piece -> Bool
$c>= :: Piece -> Piece -> Bool
>= :: Piece -> Piece -> Bool
$cmax :: Piece -> Piece -> Piece
max :: Piece -> Piece -> Piece
$cmin :: Piece -> Piece -> Piece
min :: Piece -> Piece -> Piece
Ord)

pieceFromC :: Int -> Maybe Piece
pieceFromC :: Int -> Maybe Piece
pieceFromC Int
0 = Maybe Piece
forall a. Maybe a
Nothing
pieceFromC Int
x = Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Piece -> Maybe Piece) -> Piece -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ Int -> Piece
forall a. Enum a => Int -> a
toEnum (Int -> Piece) -> Int -> Piece
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

pieceToC :: Maybe Piece -> Int
pieceToC :: Maybe Piece -> Int
pieceToC = Int -> (Piece -> Int) -> Maybe Piece -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (Piece -> Int) -> Piece -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> Int
forall a. Enum a => a -> Int
fromEnum)

-- | Player colors
data PlayerColor
  = White
  | Black
  deriving (PlayerColor -> PlayerColor -> Bool
(PlayerColor -> PlayerColor -> Bool)
-> (PlayerColor -> PlayerColor -> Bool) -> Eq PlayerColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlayerColor -> PlayerColor -> Bool
== :: PlayerColor -> PlayerColor -> Bool
$c/= :: PlayerColor -> PlayerColor -> Bool
/= :: PlayerColor -> PlayerColor -> Bool
Eq, Int -> PlayerColor -> ShowS
[PlayerColor] -> ShowS
PlayerColor -> String
(Int -> PlayerColor -> ShowS)
-> (PlayerColor -> String)
-> ([PlayerColor] -> ShowS)
-> Show PlayerColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlayerColor -> ShowS
showsPrec :: Int -> PlayerColor -> ShowS
$cshow :: PlayerColor -> String
show :: PlayerColor -> String
$cshowList :: [PlayerColor] -> ShowS
showList :: [PlayerColor] -> ShowS
Show, Int -> PlayerColor
PlayerColor -> Int
PlayerColor -> [PlayerColor]
PlayerColor -> PlayerColor
PlayerColor -> PlayerColor -> [PlayerColor]
PlayerColor -> PlayerColor -> PlayerColor -> [PlayerColor]
(PlayerColor -> PlayerColor)
-> (PlayerColor -> PlayerColor)
-> (Int -> PlayerColor)
-> (PlayerColor -> Int)
-> (PlayerColor -> [PlayerColor])
-> (PlayerColor -> PlayerColor -> [PlayerColor])
-> (PlayerColor -> PlayerColor -> [PlayerColor])
-> (PlayerColor -> PlayerColor -> PlayerColor -> [PlayerColor])
-> Enum PlayerColor
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PlayerColor -> PlayerColor
succ :: PlayerColor -> PlayerColor
$cpred :: PlayerColor -> PlayerColor
pred :: PlayerColor -> PlayerColor
$ctoEnum :: Int -> PlayerColor
toEnum :: Int -> PlayerColor
$cfromEnum :: PlayerColor -> Int
fromEnum :: PlayerColor -> Int
$cenumFrom :: PlayerColor -> [PlayerColor]
enumFrom :: PlayerColor -> [PlayerColor]
$cenumFromThen :: PlayerColor -> PlayerColor -> [PlayerColor]
enumFromThen :: PlayerColor -> PlayerColor -> [PlayerColor]
$cenumFromTo :: PlayerColor -> PlayerColor -> [PlayerColor]
enumFromTo :: PlayerColor -> PlayerColor -> [PlayerColor]
$cenumFromThenTo :: PlayerColor -> PlayerColor -> PlayerColor -> [PlayerColor]
enumFromThenTo :: PlayerColor -> PlayerColor -> PlayerColor -> [PlayerColor]
Enum, PlayerColor
PlayerColor -> PlayerColor -> Bounded PlayerColor
forall a. a -> a -> Bounded a
$cminBound :: PlayerColor
minBound :: PlayerColor
$cmaxBound :: PlayerColor
maxBound :: PlayerColor
Bounded, Eq PlayerColor
Eq PlayerColor =>
(PlayerColor -> PlayerColor -> Ordering)
-> (PlayerColor -> PlayerColor -> Bool)
-> (PlayerColor -> PlayerColor -> Bool)
-> (PlayerColor -> PlayerColor -> Bool)
-> (PlayerColor -> PlayerColor -> Bool)
-> (PlayerColor -> PlayerColor -> PlayerColor)
-> (PlayerColor -> PlayerColor -> PlayerColor)
-> Ord PlayerColor
PlayerColor -> PlayerColor -> Bool
PlayerColor -> PlayerColor -> Ordering
PlayerColor -> PlayerColor -> PlayerColor
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PlayerColor -> PlayerColor -> Ordering
compare :: PlayerColor -> PlayerColor -> Ordering
$c< :: PlayerColor -> PlayerColor -> Bool
< :: PlayerColor -> PlayerColor -> Bool
$c<= :: PlayerColor -> PlayerColor -> Bool
<= :: PlayerColor -> PlayerColor -> Bool
$c> :: PlayerColor -> PlayerColor -> Bool
> :: PlayerColor -> PlayerColor -> Bool
$c>= :: PlayerColor -> PlayerColor -> Bool
>= :: PlayerColor -> PlayerColor -> Bool
$cmax :: PlayerColor -> PlayerColor -> PlayerColor
max :: PlayerColor -> PlayerColor -> PlayerColor
$cmin :: PlayerColor -> PlayerColor -> PlayerColor
min :: PlayerColor -> PlayerColor -> PlayerColor
Ord)

colorFromC :: Int -> Maybe PlayerColor
colorFromC :: Int -> Maybe PlayerColor
colorFromC (-1) = Maybe PlayerColor
forall a. Maybe a
Nothing
colorFromC Int
x = PlayerColor -> Maybe PlayerColor
forall a. a -> Maybe a
Just (PlayerColor -> Maybe PlayerColor)
-> PlayerColor -> Maybe PlayerColor
forall a b. (a -> b) -> a -> b
$ Int -> PlayerColor
forall a. Enum a => Int -> a
toEnum Int
x

colorToC :: PlayerColor -> Int
colorToC :: PlayerColor -> Int
colorToC = PlayerColor -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Game state.
data State
  = -- | The game is ongoing.
    Normal
  | -- | The game has ended in a stalemate.
    Stalemate
  | -- | The game has ended in a checkmate.
    Checkmate
  deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State -> ShowS
showsPrec :: Int -> State -> ShowS
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> ShowS
showList :: [State] -> ShowS
Show, Int -> State
State -> Int
State -> [State]
State -> State
State -> State -> [State]
State -> State -> State -> [State]
(State -> State)
-> (State -> State)
-> (Int -> State)
-> (State -> Int)
-> (State -> [State])
-> (State -> State -> [State])
-> (State -> State -> [State])
-> (State -> State -> State -> [State])
-> Enum State
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: State -> State
succ :: State -> State
$cpred :: State -> State
pred :: State -> State
$ctoEnum :: Int -> State
toEnum :: Int -> State
$cfromEnum :: State -> Int
fromEnum :: State -> Int
$cenumFrom :: State -> [State]
enumFrom :: State -> [State]
$cenumFromThen :: State -> State -> [State]
enumFromThen :: State -> State -> [State]
$cenumFromTo :: State -> State -> [State]
enumFromTo :: State -> State -> [State]
$cenumFromThenTo :: State -> State -> State -> [State]
enumFromThenTo :: State -> State -> State -> [State]
Enum, State
State -> State -> Bounded State
forall a. a -> a -> Bounded a
$cminBound :: State
minBound :: State
$cmaxBound :: State
maxBound :: State
Bounded, Eq State
Eq State =>
(State -> State -> Ordering)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> State)
-> (State -> State -> State)
-> Ord State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: State -> State -> Ordering
compare :: State -> State -> Ordering
$c< :: State -> State -> Bool
< :: State -> State -> Bool
$c<= :: State -> State -> Bool
<= :: State -> State -> Bool
$c> :: State -> State -> Bool
> :: State -> State -> Bool
$c>= :: State -> State -> Bool
>= :: State -> State -> Bool
$cmax :: State -> State -> State
max :: State -> State -> State
$cmin :: State -> State -> State
min :: State -> State -> State
Ord)

stateFromC :: Int -> State
stateFromC :: Int -> State
stateFromC (-1) = State
Checkmate
stateFromC Int
0 = State
Normal
stateFromC Int
1 = State
Stalemate
stateFromC Int
_ = String -> State
forall a. HasCallStack => String -> a
error String
"invalid game state received from C code"

-- | A chess move, specifying the positions but not the piece to be moved.
data Move = Move
  { -- | The move's start position (a bitboard with a single set bit).
    Move -> Bitboard
from :: Bitboard,
    -- | The move's end position (a bitboard with a single set bit).
    Move -> Bitboard
to :: Bitboard,
    -- | If this move causes a pawn promotion, specifies the piece to promote it to.
    Move -> Maybe Piece
promotion :: Maybe Piece,
    -- | Whether this move is a capture.
    Move -> Bool
capture :: Bool,
    -- | Whether this move is a castle.
    Move -> Bool
castle :: Bool
  }
  deriving (Move -> Move -> Bool
(Move -> Move -> Bool) -> (Move -> Move -> Bool) -> Eq Move
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Move -> Move -> Bool
== :: Move -> Move -> Bool
$c/= :: Move -> Move -> Bool
/= :: Move -> Move -> Bool
Eq, Int -> Move -> ShowS
[Move] -> ShowS
Move -> String
(Int -> Move -> ShowS)
-> (Move -> String) -> ([Move] -> ShowS) -> Show Move
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Move -> ShowS
showsPrec :: Int -> Move -> ShowS
$cshow :: Move -> String
show :: Move -> String
$cshowList :: [Move] -> ShowS
showList :: [Move] -> ShowS
Show)

-- | A default 'Move' with all of the fields unset.
moveDefault :: Move
moveDefault :: Move
moveDefault = Bitboard -> Bitboard -> Maybe Piece -> Bool -> Bool -> Move
Move Bitboard
0 Bitboard
0 Maybe Piece
forall a. Maybe a
Nothing Bool
False Bool
False

moveFromC :: C'Move -> Move
moveFromC :: C'Move -> Move
moveFromC C'Move
move =
  Move
    { from :: Bitboard
from = C'Move -> Bitboard
c'Move'from C'Move
move,
      to :: Bitboard
to = C'Move -> Bitboard
c'Move'to C'Move
move,
      promotion :: Maybe Piece
promotion = Int -> Maybe Piece
pieceFromC (Int -> Maybe Piece) -> Int -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ CUChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUChar -> Int) -> CUChar -> Int
forall a b. (a -> b) -> a -> b
$ C'Move -> CUChar
c'Move'promotion C'Move
move,
      capture :: Bool
capture = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ C'Move -> CBool
c'Move'capture C'Move
move,
      castle :: Bool
castle = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ C'Move -> CBool
c'Move'castle C'Move
move
    }

-- Perform unsafe IO on a Board
unsafeBoard :: (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard :: forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard Ptr C'Board -> IO a
action (Board ForeignPtr C'Board
board) = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ForeignPtr C'Board -> (Ptr C'Board -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr C'Board
board Ptr C'Board -> IO a
action

-- | Get the game's current board. The current board changes after every move.
getBoard :: IO Board
getBoard :: IO Board
getBoard = ForeignPtr C'Board -> Board
Board (ForeignPtr C'Board -> Board)
-> IO (ForeignPtr C'Board) -> IO Board
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Ptr C'Board)
c'chess_get_board IO (Ptr C'Board)
-> (Ptr C'Board -> IO (ForeignPtr C'Board))
-> IO (ForeignPtr C'Board)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr C'Board -> Ptr C'Board -> IO (ForeignPtr C'Board)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr C'Board
p'chess_free_board)

opponentMove :: IO Move
opponentMove :: IO Move
opponentMove = C'Move -> Move
moveFromC (C'Move -> Move) -> IO C'Move -> IO Move
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Ptr C'Move)
c'chess_get_opponent_move_ptr IO (Ptr C'Move) -> (Ptr C'Move -> IO C'Move) -> IO C'Move
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr C'Move -> IO C'Move
forall a. Storable a => Ptr a -> IO a
peek)

-- | Submit a move that you are going to play.
submitMove :: Move -> IO ()
submitMove :: Move -> IO ()
submitMove Move
move = do
  CULong -> CULong -> CUChar -> CBool -> CBool -> IO ()
c'chess_push_unrolled
    (Bitboard -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bitboard -> CULong) -> Bitboard -> CULong
forall a b. (a -> b) -> a -> b
$ Move -> Bitboard
from Move
move)
    (Bitboard -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bitboard -> CULong) -> Bitboard -> CULong
forall a b. (a -> b) -> a -> b
$ Move -> Bitboard
to Move
move)
    (Int -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUChar) -> Int -> CUChar
forall a b. (a -> b) -> a -> b
$ Maybe Piece -> Int
pieceToC (Maybe Piece -> Int) -> Maybe Piece -> Int
forall a b. (a -> b) -> a -> b
$ Move -> Maybe Piece
promotion Move
move)
    (Bool -> CBool
forall a. Num a => Bool -> a
fromBool (Bool -> CBool) -> Bool -> CBool
forall a b. (a -> b) -> a -> b
$ Move -> Bool
capture Move
move)
    (Bool -> CBool
forall a. Num a => Bool -> a
fromBool (Bool -> CBool) -> Bool -> CBool
forall a b. (a -> b) -> a -> b
$ Move -> Bool
castle Move
move)
  IO ()
c'chess_done

-- | Get the time that was remaining at the start of the turn in milliseconds.
getTimeMillis :: IO Int
getTimeMillis :: IO Int
getTimeMillis = CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong -> Int) -> IO CLong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CLong
c'chess_get_time_millis

-- | Get opponent's remaining time in milliseconds.
getOpponentTimeMillis :: IO Int
getOpponentTimeMillis :: IO Int
getOpponentTimeMillis = CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong -> Int) -> IO CLong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CLong
c'chess_get_time_millis

-- | Get time elapsed since the start of the turn in milliseconds.
getElapsedTimeMillis :: IO Int
getElapsedTimeMillis :: IO Int
getElapsedTimeMillis = CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong -> Int) -> IO CLong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CLong
c'chess_get_time_millis

-- | List legal moves for a board. Note that it may be either your or your opponent's moves depending on
-- what 'nextTurnColor' returns.
legalMoves :: Board -> [Move]
legalMoves :: Board -> [Move]
legalMoves = (Ptr C'Board -> IO [Move]) -> Board -> [Move]
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO [Move]) -> Board -> [Move])
-> (Ptr C'Board -> IO [Move]) -> Board -> [Move]
forall a b. (a -> b) -> a -> b
$ \Ptr C'Board
board -> do
  n <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
malloc
  moves <- c'chess_get_legal_moves board n
  num <- peek n
  free n
  arr <- newForeignPtr p'chess_free_moves_array moves
  withForeignPtr arr $ fmap (map moveFromC) . peekArray (fromIntegral num)

-- | Returns the player whose turn it currently is.
nextTurnColor :: Board -> PlayerColor
nextTurnColor :: Board -> PlayerColor
nextTurnColor = (Ptr C'Board -> IO PlayerColor) -> Board -> PlayerColor
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((CBool -> PlayerColor) -> IO CBool -> IO PlayerColor
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PlayerColor
forall a. Enum a => Int -> a
toEnum (Int -> PlayerColor) -> (CBool -> Int) -> CBool -> PlayerColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBool -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CBool -> IO PlayerColor)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO PlayerColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CBool
c'chess_is_black_turn)

-- | Whether it's white's turn.
isWhiteTurn :: Board -> Bool
isWhiteTurn :: Board -> Bool
isWhiteTurn = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CBool
c'chess_is_white_turn)

-- | Whether it's black's turn.
isBlackTurn :: Board -> Bool
isBlackTurn :: Board -> Bool
isBlackTurn = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CBool
c'chess_is_black_turn)

-- | Skips a player's turn, returning an equivalent board where it's the opposite player's turn.
skipTurn :: Board -> Board
skipTurn :: Board -> Board
skipTurn = (Ptr C'Board -> IO Board) -> Board -> Board
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Board) -> Board -> Board)
-> (Ptr C'Board -> IO Board) -> Board -> Board
forall a b. (a -> b) -> a -> b
$ \Ptr C'Board
board -> do
  b <- Ptr C'Board -> IO (Ptr C'Board)
c'chess_clone_board Ptr C'Board
board
  c'chess_skip_turn b
  Board <$> newForeignPtr p'chess_free_board b

-- | Get a game's current state (whether it's a checkmate, stalemate, or neither).
gameState :: Board -> State
gameState :: Board -> State
gameState = (Ptr C'Board -> IO State) -> Board -> State
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO State) -> Board -> State)
-> (Ptr C'Board -> IO State) -> Board -> State
forall a b. (a -> b) -> a -> b
$ (CInt -> State) -> IO CInt -> IO State
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> State
stateFromC (Int -> State) -> (CInt -> Int) -> CInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO State)
-> (Ptr C'Board -> IO CInt) -> Ptr C'Board -> IO State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CInt
c'chess_get_game_state

-- | Whether the current player is in check.
inCheck :: Board -> Bool
inCheck :: Board -> Bool
inCheck = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Bool) -> Board -> Bool)
-> (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CBool
c'chess_in_check

-- | Whether the current player is in checkmate.
inCheckmate :: Board -> Bool
inCheckmate :: Board -> Bool
inCheckmate = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Bool) -> Board -> Bool)
-> (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CBool
c'chess_in_checkmate

-- | Whether the current player is in a draw.
inDraw :: Board -> Bool
inDraw :: Board -> Bool
inDraw = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Bool) -> Board -> Bool)
-> (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CBool
c'chess_in_draw

-- | Whether a particular player is allowed to castle kingside at some point in the game.
canCastleKingside :: PlayerColor -> Board -> Bool
canCastleKingside :: PlayerColor -> Board -> Bool
canCastleKingside PlayerColor
side = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Bool) -> Board -> Bool)
-> (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'Board -> C'PlayerColor -> IO CBool)
-> C'PlayerColor -> Ptr C'Board -> IO CBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr C'Board -> C'PlayerColor -> IO CBool
c'chess_can_kingside_castle (Int -> C'PlayerColor
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C'PlayerColor) -> Int -> C'PlayerColor
forall a b. (a -> b) -> a -> b
$ PlayerColor -> Int
colorToC PlayerColor
side)

-- | Whether a particular player is allowed to castle queenside at some point in the game.
canCastleQueenside :: PlayerColor -> Board -> Bool
canCastleQueenside :: PlayerColor -> Board -> Bool
canCastleQueenside PlayerColor
side = (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Bool) -> Board -> Bool)
-> (Ptr C'Board -> IO Bool) -> Board -> Bool
forall a b. (a -> b) -> a -> b
$ (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CBool -> IO Bool)
-> (Ptr C'Board -> IO CBool) -> Ptr C'Board -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'Board -> C'PlayerColor -> IO CBool)
-> C'PlayerColor -> Ptr C'Board -> IO CBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr C'Board -> C'PlayerColor -> IO CBool
c'chess_can_kingside_castle (Int -> C'PlayerColor
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C'PlayerColor) -> Int -> C'PlayerColor
forall a b. (a -> b) -> a -> b
$ PlayerColor -> Int
colorToC PlayerColor
side)

-- | Get a board's Zobrist hash.
zobristKey :: Board -> Int
zobristKey :: Board -> Int
zobristKey = (Ptr C'Board -> IO Int) -> Board -> Int
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Int) -> Board -> Int)
-> (Ptr C'Board -> IO Int) -> Board -> Int
forall a b. (a -> b) -> a -> b
$ (Bitboard -> Int) -> IO Bitboard -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bitboard -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Bitboard -> IO Int)
-> (Ptr C'Board -> IO Bitboard) -> Ptr C'Board -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO Bitboard
c'chess_zobrist_key

-- | Make a move on a board, returning a new board with that move made.
pushMove :: Move -> Board -> Board
pushMove :: Move -> Board -> Board
pushMove Move
move = (Ptr C'Board -> IO Board) -> Board -> Board
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Board) -> Board -> Board)
-> (Ptr C'Board -> IO Board) -> Board -> Board
forall a b. (a -> b) -> a -> b
$ \Ptr C'Board
board -> do
  b <- Ptr C'Board -> IO (Ptr C'Board)
c'chess_clone_board Ptr C'Board
board
  c'chess_make_move_unrolled
    b
    (fromIntegral $ from move)
    (fromIntegral $ to move)
    (fromIntegral $ pieceToC $ promotion move)
    (fromBool $ capture move)
    (fromBool $ castle move)
  Board <$> newForeignPtr p'chess_free_board b

-- | Undo a move on a board, returning a board without that move.
popMove :: Board -> Board
popMove :: Board -> Board
popMove = (Ptr C'Board -> IO Board) -> Board -> Board
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Board) -> Board -> Board)
-> (Ptr C'Board -> IO Board) -> Board -> Board
forall a b. (a -> b) -> a -> b
$ \Ptr C'Board
board -> do
  b <- Ptr C'Board -> IO (Ptr C'Board)
c'chess_clone_board Ptr C'Board
board
  c'chess_undo_move b
  Board <$> newForeignPtr p'chess_free_board b

-- | Read the full move counter (starts at 1, increments each time black moves)
fullMoves :: Board -> Int
fullMoves :: Board -> Int
fullMoves = (Ptr C'Board -> IO Int) -> Board -> Int
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Int) -> Board -> Int)
-> (Ptr C'Board -> IO Int) -> Board -> Int
forall a b. (a -> b) -> a -> b
$ (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int)
-> (Ptr C'Board -> IO CInt) -> Ptr C'Board -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CInt
c'chess_get_full_moves

-- | Read the half move counter (starts at 0, increments after every move, resets to 0 after pawn moves or captures).
-- Used for the 50-move draw rule.
halfMoves :: Board -> Int
halfMoves :: Board -> Int
halfMoves = (Ptr C'Board -> IO Int) -> Board -> Int
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Int) -> Board -> Int)
-> (Ptr C'Board -> IO Int) -> Board -> Int
forall a b. (a -> b) -> a -> b
$ (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int)
-> (Ptr C'Board -> IO CInt) -> Ptr C'Board -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'Board -> IO CInt
c'chess_get_half_moves

-- | Get a bitboard for a particular player and piece. The bitboard's bits will indicate the presence
-- of that particular piece of that particular color on each square of the board.
bitboard :: PlayerColor -> Piece -> Board -> Bitboard
bitboard :: PlayerColor -> Piece -> Board -> Bitboard
bitboard PlayerColor
color Piece
piece = (Ptr C'Board -> IO Bitboard) -> Board -> Bitboard
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO Bitboard) -> Board -> Bitboard)
-> (Ptr C'Board -> IO Bitboard) -> Board -> Bitboard
forall a b. (a -> b) -> a -> b
$ \Ptr C'Board
b ->
  CULong -> Bitboard
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (CULong -> Bitboard) -> IO CULong -> IO Bitboard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'Board -> C'PlayerColor -> C'PlayerColor -> IO CULong
c'chess_get_bitboard
      Ptr C'Board
b
      (Int -> C'PlayerColor
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C'PlayerColor) -> Int -> C'PlayerColor
forall a b. (a -> b) -> a -> b
$ PlayerColor -> Int
colorToC PlayerColor
color)
      (Int -> C'PlayerColor
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C'PlayerColor) -> Int -> C'PlayerColor
forall a b. (a -> b) -> a -> b
$ Maybe Piece -> Int
pieceToC (Maybe Piece -> Int) -> Maybe Piece -> Int
forall a b. (a -> b) -> a -> b
$ Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
piece)

-- | Get the piece located at a particular index.
pieceFromIndex :: Int -> Board -> Maybe Piece
pieceFromIndex :: Int -> Board -> Maybe Piece
pieceFromIndex Int
i = (Ptr C'Board -> IO (Maybe Piece)) -> Board -> Maybe Piece
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO (Maybe Piece)) -> Board -> Maybe Piece)
-> (Ptr C'Board -> IO (Maybe Piece)) -> Board -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ (C'PlayerColor -> Maybe Piece)
-> IO C'PlayerColor -> IO (Maybe Piece)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Piece
pieceFromC (Int -> Maybe Piece)
-> (C'PlayerColor -> Int) -> C'PlayerColor -> Maybe Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C'PlayerColor -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO C'PlayerColor -> IO (Maybe Piece))
-> (Ptr C'Board -> IO C'PlayerColor)
-> Ptr C'Board
-> IO (Maybe Piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'Board -> CInt -> IO C'PlayerColor)
-> CInt -> Ptr C'Board -> IO C'PlayerColor
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr C'Board -> CInt -> IO C'PlayerColor
c'chess_get_piece_from_index (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

-- | Get the piece located at the position set in the bitboard.
pieceFromBitboard :: Bitboard -> Board -> Maybe Piece
pieceFromBitboard :: Bitboard -> Board -> Maybe Piece
pieceFromBitboard Bitboard
b = (Ptr C'Board -> IO (Maybe Piece)) -> Board -> Maybe Piece
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO (Maybe Piece)) -> Board -> Maybe Piece)
-> (Ptr C'Board -> IO (Maybe Piece)) -> Board -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ (C'PlayerColor -> Maybe Piece)
-> IO C'PlayerColor -> IO (Maybe Piece)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Piece
pieceFromC (Int -> Maybe Piece)
-> (C'PlayerColor -> Int) -> C'PlayerColor -> Maybe Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C'PlayerColor -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO C'PlayerColor -> IO (Maybe Piece))
-> (Ptr C'Board -> IO C'PlayerColor)
-> Ptr C'Board
-> IO (Maybe Piece)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'Board -> Bitboard -> IO C'PlayerColor)
-> Bitboard -> Ptr C'Board -> IO C'PlayerColor
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr C'Board -> Bitboard -> IO C'PlayerColor
c'chess_get_piece_from_bitboard Bitboard
b

-- | Get the player color for the piece located at a particular index.
colorFromIndex :: Int -> Board -> Maybe PlayerColor
colorFromIndex :: Int -> Board -> Maybe PlayerColor
colorFromIndex Int
i = (Ptr C'Board -> IO (Maybe PlayerColor))
-> Board -> Maybe PlayerColor
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO (Maybe PlayerColor))
 -> Board -> Maybe PlayerColor)
-> (Ptr C'Board -> IO (Maybe PlayerColor))
-> Board
-> Maybe PlayerColor
forall a b. (a -> b) -> a -> b
$ (C'PlayerColor -> Maybe PlayerColor)
-> IO C'PlayerColor -> IO (Maybe PlayerColor)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe PlayerColor
colorFromC (Int -> Maybe PlayerColor)
-> (C'PlayerColor -> Int) -> C'PlayerColor -> Maybe PlayerColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C'PlayerColor -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO C'PlayerColor -> IO (Maybe PlayerColor))
-> (Ptr C'Board -> IO C'PlayerColor)
-> Ptr C'Board
-> IO (Maybe PlayerColor)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'Board -> CInt -> IO C'PlayerColor)
-> CInt -> Ptr C'Board -> IO C'PlayerColor
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr C'Board -> CInt -> IO C'PlayerColor
c'chess_get_color_from_index (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

-- | Get the player color for the piece located at the position set in the bitboard.
colorFromBitboard :: Bitboard -> Board -> Maybe PlayerColor
colorFromBitboard :: Bitboard -> Board -> Maybe PlayerColor
colorFromBitboard Bitboard
b = (Ptr C'Board -> IO (Maybe PlayerColor))
-> Board -> Maybe PlayerColor
forall a. (Ptr C'Board -> IO a) -> Board -> a
unsafeBoard ((Ptr C'Board -> IO (Maybe PlayerColor))
 -> Board -> Maybe PlayerColor)
-> (Ptr C'Board -> IO (Maybe PlayerColor))
-> Board
-> Maybe PlayerColor
forall a b. (a -> b) -> a -> b
$ (C'PlayerColor -> Maybe PlayerColor)
-> IO C'PlayerColor -> IO (Maybe PlayerColor)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe PlayerColor
colorFromC (Int -> Maybe PlayerColor)
-> (C'PlayerColor -> Int) -> C'PlayerColor -> Maybe PlayerColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C'PlayerColor -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO C'PlayerColor -> IO (Maybe PlayerColor))
-> (Ptr C'Board -> IO C'PlayerColor)
-> Ptr C'Board
-> IO (Maybe PlayerColor)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'Board -> Bitboard -> IO C'PlayerColor)
-> Bitboard -> Ptr C'Board -> IO C'PlayerColor
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr C'Board -> Bitboard -> IO C'PlayerColor
c'chess_get_color_from_bitboard Bitboard
b

-- | Convert a bitboard with a single set bit to a cell index.
indexFromBitboard :: Bitboard -> Int
indexFromBitboard :: Bitboard -> Int
indexFromBitboard Bitboard
x = Bitboard -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Bitboard
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bitboard -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Bitboard
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Convert a cell index to a bitboard with a single set bit.
bitboardFromIndex :: Int -> Bitboard
bitboardFromIndex :: Int -> Bitboard
bitboardFromIndex = Int -> Bitboard
forall a. Bits a => Int -> a
bit

-- | Get a printable string for a bitboard (a grid with 8 columns and 8 lines)
showBitboard :: Bitboard -> String
showBitboard :: Bitboard -> String
showBitboard Bitboard
bb =
  ShowS
addNewlines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> if Bitboard -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Bitboard
bb Int
x then Char
'X' else Char
'-') [Int
0 .. Int
63]
  where
    addNewlines :: [Char] -> [Char]
    addNewlines :: ShowS
addNewlines (Char
a : Char
b : Char
c : Char
d : Char
e : Char
f : Char
g : Char
h : String
rest) = Char
a Char -> ShowS
forall a. a -> [a] -> [a]
: Char
b Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: Char
e Char -> ShowS
forall a. a -> [a] -> [a]
: Char
f Char -> ShowS
forall a. a -> [a] -> [a]
: Char
g Char -> ShowS
forall a. a -> [a] -> [a]
: Char
h Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
addNewlines String
rest
    addNewlines String
x = String
x

-- | Move all elements of the bitboard in a particular direction.
bbSlide :: Dir -> Bitboard -> Bitboard
bbSlide :: Dir -> Bitboard -> Bitboard
bbSlide Dir
N = (Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
bbSlide Dir
S = (Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
bbSlide Dir
E = (Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
0xfefefefefefefefe) (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
bbSlide Dir
W = (Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
0x7f7f7f7f7f7f7f7f) (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bitboard -> Int -> Bitboard
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
bbSlide Dir
NE = Dir -> Bitboard -> Bitboard
bbSlide Dir
E (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Bitboard -> Bitboard
bbSlide Dir
N
bbSlide Dir
SE = Dir -> Bitboard -> Bitboard
bbSlide Dir
E (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Bitboard -> Bitboard
bbSlide Dir
S
bbSlide Dir
NW = Dir -> Bitboard -> Bitboard
bbSlide Dir
W (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Bitboard -> Bitboard
bbSlide Dir
N
bbSlide Dir
SW = Dir -> Bitboard -> Bitboard
bbSlide Dir
W (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Bitboard -> Bitboard
bbSlide Dir
S

-- | Travel in a particular direction, setting all bits until encountering a nonempty space, returning all marked spaces.
bbFlood ::
  -- | Whether to also include the final nonempty space.
  Bool ->
  -- | Direction to move in.
  Dir ->
  -- | A bitboard representing a set of empty spaces on the board.
  Bitboard ->
  -- | The bitboard to shift (with a single set bit).
  Bitboard ->
  -- | The board with movement squares marked. The original square will not be marked.
  Bitboard
bbFlood :: Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Bool
captures Dir
dir Bitboard
empty Bitboard
board =
  (if Bool
captures then Dir -> Bitboard -> Bitboard
bbSlide Dir
dir else (Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
empty)) (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall a b. (a -> b) -> a -> b
$ (Bitboard -> Bitboard -> Bitboard)
-> Bitboard -> [Bitboard] -> Bitboard
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
(.|.) Bitboard
board ((Bitboard -> Bitboard) -> [Bitboard] -> [Bitboard]
forall a b. (a -> b) -> [a] -> [b]
map ((Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
empty) (Bitboard -> Bitboard)
-> (Bitboard -> Bitboard) -> Bitboard -> Bitboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> Bitboard -> Bitboard
bbSlide Dir
dir) [Bitboard
0 .. Bitboard
6])

-- | Travel in a particular direction until encountering a nonempty space.
bbBlocker ::
  -- | Direction to move in.
  Dir ->
  -- | A bitboard representing a set of empty spaces on the board.
  Bitboard ->
  -- | A bitboard to shift (with a single set bit).
  Bitboard ->
  -- | The board after a shift encountered a nonempty space.
  Bitboard
bbBlocker :: Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
dir Bitboard
empty =
  Int -> Bitboard -> Bitboard
run Int
7
  where
    run :: Int -> Bitboard -> Bitboard
    run :: Int -> Bitboard -> Bitboard
run Int
0 Bitboard
x = Bitboard
x
    run Int
n Bitboard
x = let y :: Bitboard
y = Dir -> Bitboard -> Bitboard
bbSlide Dir
dir Bitboard
x in if Bitboard
y Bitboard -> Bitboard -> Bitboard
forall a. Bits a => a -> a -> a
.&. Bitboard
empty Bitboard -> Bitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Bitboard
0 then Bitboard
y else Int -> Bitboard -> Bitboard
run (Int -> Int
forall a. Enum a => a -> a
pred Int
n) Bitboard
x

bbSlideN :: Bitboard -> Bitboard
bbSlideN :: Bitboard -> Bitboard
bbSlideN = Dir -> Bitboard -> Bitboard
bbSlide Dir
N

bbSlideS :: Bitboard -> Bitboard
bbSlideS :: Bitboard -> Bitboard
bbSlideS = Dir -> Bitboard -> Bitboard
bbSlide Dir
S

bbSlideE :: Bitboard -> Bitboard
bbSlideE :: Bitboard -> Bitboard
bbSlideE = Dir -> Bitboard -> Bitboard
bbSlide Dir
E

bbSlideW :: Bitboard -> Bitboard
bbSlideW :: Bitboard -> Bitboard
bbSlideW = Dir -> Bitboard -> Bitboard
bbSlide Dir
W

bbSlideNE :: Bitboard -> Bitboard
bbSlideNE :: Bitboard -> Bitboard
bbSlideNE = Dir -> Bitboard -> Bitboard
bbSlide Dir
NE

bbSlideSE :: Bitboard -> Bitboard
bbSlideSE :: Bitboard -> Bitboard
bbSlideSE = Dir -> Bitboard -> Bitboard
bbSlide Dir
SE

bbSlideNW :: Bitboard -> Bitboard
bbSlideNW :: Bitboard -> Bitboard
bbSlideNW = Dir -> Bitboard -> Bitboard
bbSlide Dir
NW

bbSlideSW :: Bitboard -> Bitboard
bbSlideSW :: Bitboard -> Bitboard
bbSlideSW = Dir -> Bitboard -> Bitboard
bbSlide Dir
SW

bbFloodN :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodN :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodN = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
N

bbFloodS :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodS :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodS = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
S

bbFloodE :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodE :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodE = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
E

bbFloodW :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodW :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodW = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
W

bbFloodNE :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodNE :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodNE = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
NE

bbFloodSE :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodSE :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodSE = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
SE

bbFloodNW :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodNW :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodNW = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
NW

bbFloodSW :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodSW :: Bool -> Bitboard -> Bitboard -> Bitboard
bbFloodSW = (Bool -> Dir -> Bitboard -> Bitboard -> Bitboard)
-> Dir -> Bool -> Bitboard -> Bitboard -> Bitboard
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Dir -> Bitboard -> Bitboard -> Bitboard
bbFlood Dir
SW

bbBlockerN :: Bitboard -> Bitboard -> Bitboard
bbBlockerN :: Bitboard -> Bitboard -> Bitboard
bbBlockerN = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
N

bbBlockerS :: Bitboard -> Bitboard -> Bitboard
bbBlockerS :: Bitboard -> Bitboard -> Bitboard
bbBlockerS = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
S

bbBlockerE :: Bitboard -> Bitboard -> Bitboard
bbBlockerE :: Bitboard -> Bitboard -> Bitboard
bbBlockerE = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
E

bbBlockerW :: Bitboard -> Bitboard -> Bitboard
bbBlockerW :: Bitboard -> Bitboard -> Bitboard
bbBlockerW = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
W

bbBlockerNE :: Bitboard -> Bitboard -> Bitboard
bbBlockerNE :: Bitboard -> Bitboard -> Bitboard
bbBlockerNE = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
NE

bbBlockerSE :: Bitboard -> Bitboard -> Bitboard
bbBlockerSE :: Bitboard -> Bitboard -> Bitboard
bbBlockerSE = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
SE

bbBlockerNW :: Bitboard -> Bitboard -> Bitboard
bbBlockerNW :: Bitboard -> Bitboard -> Bitboard
bbBlockerNW = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
NW

bbBlockerSW :: Bitboard -> Bitboard -> Bitboard
bbBlockerSW :: Bitboard -> Bitboard -> Bitboard
bbBlockerSW = Dir -> Bitboard -> Bitboard -> Bitboard
bbBlocker Dir
SW