module Chess.Bindings where

import Foreign
import Foreign.C.Types

type C'PlayerColor = CUInt

type C'PieceType = CUInt

type C'GameState = CInt

data C'Board = C'Board

type C'Bitboard = Word64

data C'Move = C'Move
  { C'Move -> C'Bitboard
c'Move'from :: C'Bitboard,
    C'Move -> C'Bitboard
c'Move'to :: C'Bitboard,
    C'Move -> CUChar
c'Move'promotion :: CUChar,
    C'Move -> CBool
c'Move'capture :: CBool,
    C'Move -> CBool
c'Move'castle :: CBool
  }
  deriving (C'Move -> C'Move -> Bool
(C'Move -> C'Move -> Bool)
-> (C'Move -> C'Move -> Bool) -> Eq C'Move
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: C'Move -> C'Move -> Bool
== :: C'Move -> C'Move -> Bool
$c/= :: C'Move -> C'Move -> Bool
/= :: C'Move -> C'Move -> Bool
Eq, Int -> C'Move -> ShowS
[C'Move] -> ShowS
C'Move -> String
(Int -> C'Move -> ShowS)
-> (C'Move -> String) -> ([C'Move] -> ShowS) -> Show C'Move
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> C'Move -> ShowS
showsPrec :: Int -> C'Move -> ShowS
$cshow :: C'Move -> String
show :: C'Move -> String
$cshowList :: [C'Move] -> ShowS
showList :: [C'Move] -> ShowS
Show)

p'Move'from :: Ptr C'Move -> Ptr C'Bitboard
p'Move'from Ptr C'Move
p = Ptr C'Move -> Int -> Ptr C'Bitboard
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'Move
p Int
0

p'Move'from :: Ptr C'Move -> Ptr Word64

p'Move'to :: Ptr C'Move -> Ptr C'Bitboard
p'Move'to Ptr C'Move
p = Ptr C'Move -> Int -> Ptr C'Bitboard
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'Move
p Int
8

p'Move'to :: Ptr C'Move -> Ptr Word64

p'Move'promotion :: Ptr C'Move -> Ptr CUChar
p'Move'promotion Ptr C'Move
p = Ptr C'Move -> Int -> Ptr CUChar
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'Move
p Int
16

p'Move'promotion :: Ptr C'Move -> Ptr CUChar

p'Move'capture :: Ptr C'Move -> Ptr CBool
p'Move'capture Ptr C'Move
p = Ptr C'Move -> Int -> Ptr CBool
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'Move
p Int
17

p'Move'capture :: Ptr C'Move -> Ptr CBool

p'Move'castle :: Ptr C'Move -> Ptr CBool
p'Move'castle Ptr C'Move
p = Ptr C'Move -> Int -> Ptr CBool
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'Move
p Int
18

p'Move'castle :: Ptr C'Move -> Ptr CBool

instance Storable C'Move where
  sizeOf :: C'Move -> Int
sizeOf C'Move
_ = Int
24
  alignment :: C'Move -> Int
alignment C'Move
_ = Int
8
  peek :: Ptr C'Move -> IO C'Move
peek Ptr C'Move
p = do
    v0 <- Ptr C'Move -> Int -> IO C'Bitboard
forall b. Ptr b -> Int -> IO C'Bitboard
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'Move
p Int
0
    v1 <- peekByteOff p 8
    v2 <- peekByteOff p 16
    v3 <- peekByteOff p 17
    v4 <- peekByteOff p 18
    return $ C'Move v0 v1 v2 v3 v4
  poke :: Ptr C'Move -> C'Move -> IO ()
poke Ptr C'Move
p (C'Move C'Bitboard
v0 C'Bitboard
v1 CUChar
v2 CBool
v3 CBool
v4) = do
    Ptr C'Move -> Int -> C'Bitboard -> IO ()
forall b. Ptr b -> Int -> C'Bitboard -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'Move
p Int
0 C'Bitboard
v0
    Ptr C'Move -> Int -> C'Bitboard -> IO ()
forall b. Ptr b -> Int -> C'Bitboard -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'Move
p Int
8 C'Bitboard
v1
    Ptr C'Move -> Int -> CUChar -> IO ()
forall b. Ptr b -> Int -> CUChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'Move
p Int
16 CUChar
v2
    Ptr C'Move -> Int -> CBool -> IO ()
forall b. Ptr b -> Int -> CBool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'Move
p Int
17 CBool
v3
    Ptr C'Move -> Int -> CBool -> IO ()
forall b. Ptr b -> Int -> CBool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'Move
p Int
18 CBool
v4
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

foreign import ccall unsafe "chess_get_board"
  c'chess_get_board ::
    IO (Ptr C'Board)

foreign import ccall unsafe "chess_clone_board"
  c'chess_clone_board ::
    Ptr C'Board -> IO (Ptr C'Board)

foreign import ccall unsafe "chess_get_legal_moves"
  c'chess_get_legal_moves ::
    Ptr C'Board -> Ptr CInt -> IO (Ptr C'Move)

foreign import ccall unsafe "chess_is_white_turn"
  c'chess_is_white_turn ::
    Ptr C'Board -> IO CBool

foreign import ccall unsafe "chess_is_black_turn"
  c'chess_is_black_turn ::
    Ptr C'Board -> IO CBool

foreign import ccall unsafe "chess_skip_turn"
  c'chess_skip_turn ::
    Ptr C'Board -> IO ()

foreign import ccall unsafe "chess_in_check"
  c'chess_in_check ::
    Ptr C'Board -> IO CBool

foreign import ccall unsafe "chess_in_checkmate"
  c'chess_in_checkmate ::
    Ptr C'Board -> IO CBool

foreign import ccall unsafe "chess_in_draw"
  c'chess_in_draw ::
    Ptr C'Board -> IO CBool

foreign import ccall unsafe "chess_can_kingside_castle"
  c'chess_can_kingside_castle ::
    Ptr C'Board -> C'PlayerColor -> IO CBool

foreign import ccall unsafe "chess_can_queenside_castle"
  c'chess_can_queenside_castle ::
    Ptr C'Board -> C'PlayerColor -> IO CBool

foreign import ccall unsafe "chess_get_game_state"
  c'chess_get_game_state ::
    Ptr C'Board -> IO C'GameState

foreign import ccall unsafe "chess_zobrist_key"
  c'chess_zobrist_key ::
    Ptr C'Board -> IO Word64

foreign import ccall unsafe "chess_make_move_unrolled"
  c'chess_make_move_unrolled ::
    Ptr C'Board -> CULong -> CULong -> CUChar -> CBool -> CBool -> IO ()

foreign import ccall unsafe "chess_undo_move"
  c'chess_undo_move ::
    Ptr C'Board -> IO ()

foreign import ccall unsafe "chess_free_board"
  c'chess_free_board ::
    Ptr C'Board -> IO ()

foreign import ccall unsafe "&chess_free_board"
  p'chess_free_board ::
    FinalizerPtr C'Board

foreign import ccall unsafe "chess_get_bitboard"
  c'chess_get_bitboard ::
    Ptr C'Board -> C'PlayerColor -> C'PieceType -> IO CULong

foreign import ccall unsafe "chess_get_full_moves"
  c'chess_get_full_moves ::
    Ptr C'Board -> IO CInt

foreign import ccall unsafe "chess_get_half_moves"
  c'chess_get_half_moves ::
    Ptr C'Board -> IO CInt

foreign import ccall unsafe "chess_push_unrolled"
  c'chess_push_unrolled ::
    CULong -> CULong -> CUChar -> CBool -> CBool -> IO ()

foreign import ccall unsafe "chess_done"
  c'chess_done ::
    IO ()

foreign import ccall unsafe "chess_get_time_millis"
  c'chess_get_time_millis ::
    IO CLong

foreign import ccall unsafe "chess_get_opponent_time_millis"
  c'chess_get_opponent_time_millis ::
    IO CLong

foreign import ccall unsafe "chess_get_elapsed_time_millis"
  c'chess_get_elapsed_time_millis ::
    IO CLong

foreign import ccall unsafe "chess_get_piece_from_index"
  c'chess_get_piece_from_index ::
    Ptr C'Board -> CInt -> IO C'PieceType

foreign import ccall unsafe "chess_get_piece_from_bitboard"
  c'chess_get_piece_from_bitboard ::
    Ptr C'Board -> Word64 -> IO C'PieceType

foreign import ccall unsafe "chess_get_color_from_index"
  c'chess_get_color_from_index ::
    Ptr C'Board -> CInt -> IO C'PlayerColor

foreign import ccall unsafe "chess_get_color_from_bitboard"
  c'chess_get_color_from_bitboard ::
    Ptr C'Board -> Word64 -> IO C'PlayerColor

foreign import ccall unsafe "chess_get_index_from_bitboard"
  c'chess_get_index_from_bitboard ::
    Word64 -> IO CInt

foreign import ccall unsafe "chess_get_bitboard_from_index"
  c'chess_get_bitboard_from_index ::
    CInt -> IO Word64

foreign import ccall unsafe "chess_get_opponent_move_ptr"
  c'chess_get_opponent_move_ptr ::
    IO (Ptr C'Move)

foreign import ccall unsafe "chess_free_moves_array"
  c'chess_free_moves_array ::
    Ptr C'Move -> IO ()

foreign import ccall unsafe "&chess_free_moves_array"
  p'chess_free_moves_array ::
    FinalizerPtr C'Move