module Models.Move (Move(..), StorableMove(..), encodeMove, decodeMove,  foldBoardAttacks, foldBoardMoves, foldBoardMovesConst, foldBoardPawnMovesConst, foldBoardSquares, foldlBoard, showBoard) where

import           AppPrelude
import           Models.Piece
import           Utils.Board

import           Data.Bits
import           Data.List            (iterate)
import qualified Data.Vector.Storable as Vector
import           Test.QuickCheck      (Arbitrary (..), chooseInt)


data Move = Move {
  Move -> Piece
piece     :: Piece,
  Move -> Promotion
promotion :: Promotion,
  Move -> Int
start     :: Square,
  Move -> Int
end       :: Square
} 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, Eq Move
Eq Move =>
(Move -> Move -> Ordering)
-> (Move -> Move -> Bool)
-> (Move -> Move -> Bool)
-> (Move -> Move -> Bool)
-> (Move -> Move -> Bool)
-> (Move -> Move -> Move)
-> (Move -> Move -> Move)
-> Ord Move
Move -> Move -> Bool
Move -> Move -> Ordering
Move -> Move -> Move
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 :: Move -> Move -> Ordering
compare :: Move -> Move -> Ordering
$c< :: Move -> Move -> Bool
< :: Move -> Move -> Bool
$c<= :: Move -> Move -> Bool
<= :: Move -> Move -> Bool
$c> :: Move -> Move -> Bool
> :: Move -> Move -> Bool
$c>= :: Move -> Move -> Bool
>= :: Move -> Move -> Bool
$cmax :: Move -> Move -> Move
max :: Move -> Move -> Move
$cmin :: Move -> Move -> Move
min :: Move -> Move -> Move
Ord, (forall x. Move -> Rep Move x)
-> (forall x. Rep Move x -> Move) -> Generic Move
forall x. Rep Move x -> Move
forall x. Move -> Rep Move x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Move -> Rep Move x
from :: forall x. Move -> Rep Move x
$cto :: forall x. Rep Move x -> Move
to :: forall x. Rep Move x -> Move
Generic)

instance Hashable Move

instance Arbitrary Move where
  arbitrary :: Gen Move
arbitrary = Piece -> Promotion -> Int -> Int -> Move
Move
    (Piece -> Promotion -> Int -> Int -> Move)
-> Gen Piece -> Gen (Promotion -> Int -> Int -> Move)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Piece
forall a. Arbitrary a => Gen a
arbitrary Gen (Promotion -> Int -> Int -> Move)
-> Gen Promotion -> Gen (Int -> Int -> Move)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Promotion
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Int -> Int -> Move) -> Gen Int -> Gen (Int -> Move)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int) -> Gen Int
chooseInt (Int
0, Int
63) Gen (Int -> Move) -> Gen Int -> Gen Move
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int) -> Gen Int
chooseInt (Int
0, Int
63)

newtype StorableMove = StorableMove Word32
  deriving (StorableMove -> StorableMove -> Bool
(StorableMove -> StorableMove -> Bool)
-> (StorableMove -> StorableMove -> Bool) -> Eq StorableMove
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorableMove -> StorableMove -> Bool
== :: StorableMove -> StorableMove -> Bool
$c/= :: StorableMove -> StorableMove -> Bool
/= :: StorableMove -> StorableMove -> Bool
Eq, Eq StorableMove
Eq StorableMove =>
(StorableMove -> StorableMove -> Ordering)
-> (StorableMove -> StorableMove -> Bool)
-> (StorableMove -> StorableMove -> Bool)
-> (StorableMove -> StorableMove -> Bool)
-> (StorableMove -> StorableMove -> Bool)
-> (StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove -> StorableMove)
-> Ord StorableMove
StorableMove -> StorableMove -> Bool
StorableMove -> StorableMove -> Ordering
StorableMove -> StorableMove -> StorableMove
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 :: StorableMove -> StorableMove -> Ordering
compare :: StorableMove -> StorableMove -> Ordering
$c< :: StorableMove -> StorableMove -> Bool
< :: StorableMove -> StorableMove -> Bool
$c<= :: StorableMove -> StorableMove -> Bool
<= :: StorableMove -> StorableMove -> Bool
$c> :: StorableMove -> StorableMove -> Bool
> :: StorableMove -> StorableMove -> Bool
$c>= :: StorableMove -> StorableMove -> Bool
>= :: StorableMove -> StorableMove -> Bool
$cmax :: StorableMove -> StorableMove -> StorableMove
max :: StorableMove -> StorableMove -> StorableMove
$cmin :: StorableMove -> StorableMove -> StorableMove
min :: StorableMove -> StorableMove -> StorableMove
Ord, Integer -> StorableMove
StorableMove -> StorableMove
StorableMove -> StorableMove -> StorableMove
(StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove)
-> (StorableMove -> StorableMove)
-> (StorableMove -> StorableMove)
-> (Integer -> StorableMove)
-> Num StorableMove
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: StorableMove -> StorableMove -> StorableMove
+ :: StorableMove -> StorableMove -> StorableMove
$c- :: StorableMove -> StorableMove -> StorableMove
- :: StorableMove -> StorableMove -> StorableMove
$c* :: StorableMove -> StorableMove -> StorableMove
* :: StorableMove -> StorableMove -> StorableMove
$cnegate :: StorableMove -> StorableMove
negate :: StorableMove -> StorableMove
$cabs :: StorableMove -> StorableMove
abs :: StorableMove -> StorableMove
$csignum :: StorableMove -> StorableMove
signum :: StorableMove -> StorableMove
$cfromInteger :: Integer -> StorableMove
fromInteger :: Integer -> StorableMove
Num, Eq StorableMove
StorableMove
Eq StorableMove =>
(StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove -> StorableMove)
-> (StorableMove -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> StorableMove
-> (Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> Bool)
-> (StorableMove -> Maybe Int)
-> (StorableMove -> Int)
-> (StorableMove -> Bool)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int -> StorableMove)
-> (StorableMove -> Int)
-> Bits StorableMove
Int -> StorableMove
StorableMove -> Bool
StorableMove -> Int
StorableMove -> Maybe Int
StorableMove -> StorableMove
StorableMove -> Int -> Bool
StorableMove -> Int -> StorableMove
StorableMove -> StorableMove -> StorableMove
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: StorableMove -> StorableMove -> StorableMove
.&. :: StorableMove -> StorableMove -> StorableMove
$c.|. :: StorableMove -> StorableMove -> StorableMove
.|. :: StorableMove -> StorableMove -> StorableMove
$cxor :: StorableMove -> StorableMove -> StorableMove
xor :: StorableMove -> StorableMove -> StorableMove
$ccomplement :: StorableMove -> StorableMove
complement :: StorableMove -> StorableMove
$cshift :: StorableMove -> Int -> StorableMove
shift :: StorableMove -> Int -> StorableMove
$crotate :: StorableMove -> Int -> StorableMove
rotate :: StorableMove -> Int -> StorableMove
$czeroBits :: StorableMove
zeroBits :: StorableMove
$cbit :: Int -> StorableMove
bit :: Int -> StorableMove
$csetBit :: StorableMove -> Int -> StorableMove
setBit :: StorableMove -> Int -> StorableMove
$cclearBit :: StorableMove -> Int -> StorableMove
clearBit :: StorableMove -> Int -> StorableMove
$ccomplementBit :: StorableMove -> Int -> StorableMove
complementBit :: StorableMove -> Int -> StorableMove
$ctestBit :: StorableMove -> Int -> Bool
testBit :: StorableMove -> Int -> Bool
$cbitSizeMaybe :: StorableMove -> Maybe Int
bitSizeMaybe :: StorableMove -> Maybe Int
$cbitSize :: StorableMove -> Int
bitSize :: StorableMove -> Int
$cisSigned :: StorableMove -> Bool
isSigned :: StorableMove -> Bool
$cshiftL :: StorableMove -> Int -> StorableMove
shiftL :: StorableMove -> Int -> StorableMove
$cunsafeShiftL :: StorableMove -> Int -> StorableMove
unsafeShiftL :: StorableMove -> Int -> StorableMove
$cshiftR :: StorableMove -> Int -> StorableMove
shiftR :: StorableMove -> Int -> StorableMove
$cunsafeShiftR :: StorableMove -> Int -> StorableMove
unsafeShiftR :: StorableMove -> Int -> StorableMove
$crotateL :: StorableMove -> Int -> StorableMove
rotateL :: StorableMove -> Int -> StorableMove
$crotateR :: StorableMove -> Int -> StorableMove
rotateR :: StorableMove -> Int -> StorableMove
$cpopCount :: StorableMove -> Int
popCount :: StorableMove -> Int
Bits, (forall x. StorableMove -> Rep StorableMove x)
-> (forall x. Rep StorableMove x -> StorableMove)
-> Generic StorableMove
forall x. Rep StorableMove x -> StorableMove
forall x. StorableMove -> Rep StorableMove x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorableMove -> Rep StorableMove x
from :: forall x. StorableMove -> Rep StorableMove x
$cto :: forall x. Rep StorableMove x -> StorableMove
to :: forall x. Rep StorableMove x -> StorableMove
Generic, Ptr StorableMove -> IO StorableMove
Ptr StorableMove -> Int -> IO StorableMove
Ptr StorableMove -> Int -> StorableMove -> IO ()
Ptr StorableMove -> StorableMove -> IO ()
StorableMove -> Int
(StorableMove -> Int)
-> (StorableMove -> Int)
-> (Ptr StorableMove -> Int -> IO StorableMove)
-> (Ptr StorableMove -> Int -> StorableMove -> IO ())
-> (forall b. Ptr b -> Int -> IO StorableMove)
-> (forall b. Ptr b -> Int -> StorableMove -> IO ())
-> (Ptr StorableMove -> IO StorableMove)
-> (Ptr StorableMove -> StorableMove -> IO ())
-> Storable StorableMove
forall b. Ptr b -> Int -> IO StorableMove
forall b. Ptr b -> Int -> StorableMove -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: StorableMove -> Int
sizeOf :: StorableMove -> Int
$calignment :: StorableMove -> Int
alignment :: StorableMove -> Int
$cpeekElemOff :: Ptr StorableMove -> Int -> IO StorableMove
peekElemOff :: Ptr StorableMove -> Int -> IO StorableMove
$cpokeElemOff :: Ptr StorableMove -> Int -> StorableMove -> IO ()
pokeElemOff :: Ptr StorableMove -> Int -> StorableMove -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO StorableMove
peekByteOff :: forall b. Ptr b -> Int -> IO StorableMove
$cpokeByteOff :: forall b. Ptr b -> Int -> StorableMove -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> StorableMove -> IO ()
$cpeek :: Ptr StorableMove -> IO StorableMove
peek :: Ptr StorableMove -> IO StorableMove
$cpoke :: Ptr StorableMove -> StorableMove -> IO ()
poke :: Ptr StorableMove -> StorableMove -> IO ()
Storable)


encodeMove :: Maybe Move -> StorableMove
encodeMove :: Maybe Move -> StorableMove
encodeMove Maybe Move
Nothing = Int -> StorableMove
forall a. Bits a => Int -> a
bit Int
31
encodeMove (Just Move {Int
Promotion
Piece
$sel:piece:Move :: Move -> Piece
$sel:promotion:Move :: Move -> Promotion
$sel:start:Move :: Move -> Int
$sel:end:Move :: Move -> Int
piece :: Piece
promotion :: Promotion
start :: Int
end :: Int
..}) = Word32 -> StorableMove
StorableMove
  (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start
  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
<< Int
8)
  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
pieceN Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
<< Int
16)
  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
promotionN Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
<< Int
24))
  where
    Piece Word8
pieceN = Piece
piece
    Promotion Word8
promotionN = Promotion
promotion

decodeMove :: StorableMove -> Maybe Move
decodeMove :: StorableMove -> Maybe Move
decodeMove (StorableMove Word32
n)
  | Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
n Int
31 = Maybe Move
forall a. Maybe a
Nothing
  | Bool
otherwise = Move -> Maybe Move
forall a. a -> Maybe a
Just (Move -> Maybe Move) -> Move -> Maybe Move
forall a b. (a -> b) -> a -> b
$! Move {
      $sel:start:Move :: Int
start = Int
start,
      $sel:end:Move :: Int
end = Int
end,
      $sel:piece:Move :: Piece
piece = Piece
piece,
      $sel:promotion:Move :: Promotion
promotion = Promotion
promotion
    }
    where
      start :: Int
start = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
63
      end :: Int
end = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
>> Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
63
      piece :: Piece
piece = Word8 -> Piece
Piece (Word8 -> Piece) -> Word8 -> Piece
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
>> Int
16)
      promotion :: Promotion
promotion = Word8 -> Promotion
Promotion (Word8 -> Promotion) -> Word8 -> Promotion
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
>> Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
7)


{-# INLINE  foldBoardAttacks #-}
foldBoardAttacks :: (Square -> Board) -> Board -> Board
foldBoardAttacks :: (Int -> Board) -> Board -> Board
foldBoardAttacks !Int -> Board
f !Board
board = Board
-> (Board -> Board -> Board) -> (Int -> Board) -> Board -> Board
forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard Board
0 Board -> Board -> Board
(.|) Int -> Board
f Board
board


{-# INLINE  foldBoardMoves #-}
foldBoardMoves :: Piece -> (Square -> Board) -> Board -> [Move] -> [Move]
foldBoardMoves :: Piece -> (Int -> Board) -> Board -> [Move] -> [Move]
foldBoardMoves !Piece
piece !Int -> Board
f !Board
board [Move]
moves =
  [Move]
-> ([Move] -> Int -> [Move]) -> (Int -> Int) -> Board -> [Move]
forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard [Move]
moves (Piece -> (Int -> Board) -> [Move] -> Int -> [Move]
foldBoardSquares Piece
piece Int -> Board
f) Int -> Int
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Board
board


{-# INLINE  foldBoardMovesConst #-}
foldBoardMovesConst :: Piece -> Square -> Board -> [Move] -> [Move]
foldBoardMovesConst :: Piece -> Int -> Board -> [Move] -> [Move]
foldBoardMovesConst !Piece
piece !Int
end !Board
board [Move]
moves =
  [Move]
-> ([Move] -> Int -> [Move]) -> (Int -> Int) -> Board -> [Move]
forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard [Move]
moves [Move] -> Int -> [Move]
genMoves Int -> Int
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Board
board
  where
    genMoves :: [Move] -> Int -> [Move]
genMoves [Move]
xs Int
start = Piece -> Promotion -> Int -> Int -> Move
Move Piece
piece Promotion
NoProm Int
start Int
end Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: [Move]
xs


{-# INLINE  foldBoardPawnMovesConst #-}
foldBoardPawnMovesConst :: Square -> Board -> [Move] -> [Move]
foldBoardPawnMovesConst :: Int -> Board -> [Move] -> [Move]
foldBoardPawnMovesConst !Int
end !Board
board [Move]
moves =
  [Move]
-> ([Move] -> Int -> [Move]) -> (Int -> Int) -> Board -> [Move]
forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard [Move]
moves [Move] -> Int -> [Move]
genMoves Int -> Int
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Board
board
  where
    genMoves :: [Move] -> Int -> [Move]
genMoves [Move]
xs Int
start = Piece -> Promotion -> Int -> Int -> Move
Move Piece
Pawn Promotion
promotion Int
start Int
end Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: [Move]
xs
    !promotion :: Promotion
promotion
      | Board -> Int -> Bool
testSquare (Board
rank_1 Board -> Board -> Board
.| Board
rank_8) Int
end = Promotion
QueenProm
      | Bool
otherwise                         = Promotion
NoProm


{-# INLINE  foldBoardSquares #-}
foldBoardSquares :: Piece -> (Square -> Board) -> [Move] -> Square -> [Move]
foldBoardSquares :: Piece -> (Int -> Board) -> [Move] -> Int -> [Move]
foldBoardSquares Piece
Pawn !Int -> Board
f [Move]
moves !Int
start =
    [Move]
-> ([Move] -> Int -> [Move]) -> (Int -> Int) -> Board -> [Move]
forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard [Move]
moves ((Int -> [Move] -> [Move]) -> [Move] -> Int -> [Move]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> [Move] -> [Move]) -> [Move] -> Int -> [Move])
-> (Int -> [Move] -> [Move]) -> [Move] -> Int -> [Move]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Move] -> [Move]
genPawnMoves Int
start) Int -> Int
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Board -> [Move]) -> Board -> [Move]
forall a b. (a -> b) -> a -> b
$! Int -> Board
f Int
start

foldBoardSquares Piece
piece !Int -> Board
f [Move]
moves !Int
start =
    [Move]
-> ([Move] -> Move -> [Move]) -> (Int -> Move) -> Board -> [Move]
forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard [Move]
moves ((Move -> [Move] -> [Move]) -> [Move] -> Move -> [Move]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Element [Move] -> [Move] -> [Move]
Move -> [Move] -> [Move]
forall seq. SemiSequence seq => Element seq -> seq -> seq
cons) (Piece -> Promotion -> Int -> Int -> Move
Move Piece
piece Promotion
NoProm Int
start) (Int -> Board
f Int
start)


{-# INLINE  genPawnMoves #-}
genPawnMoves :: Square -> Square -> [Move] -> [Move]
genPawnMoves :: Int -> Int -> [Move] -> [Move]
genPawnMoves !Int
start !Int
end [Move]
xs
  | Board -> Int -> Bool
testSquare (Board
rank_1 Board -> Board -> Board
.| Board
rank_8) Int
end =
    Piece -> Promotion -> Int -> Int -> Move
Move Piece
Pawn Promotion
QueenProm Int
start Int
end
    Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: Piece -> Promotion -> Int -> Int -> Move
Move Piece
Pawn Promotion
KnightProm Int
start Int
end
    Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: Piece -> Promotion -> Int -> Int -> Move
Move Piece
Pawn Promotion
RookProm Int
start Int
end
    Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: Piece -> Promotion -> Int -> Int -> Move
Move Piece
Pawn Promotion
BishopProm Int
start Int
end
    Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: [Move]
xs
  | Bool
otherwise =
    Piece -> Promotion -> Int -> Int -> Move
Move Piece
Pawn Promotion
NoProm Int
start Int
end Move -> [Move] -> [Move]
forall a. a -> [a] -> [a]
: [Move]
xs


{-# INLINE  foldlBoard #-}
foldlBoard :: a -> (a -> b -> a) -> (Square -> b) -> Board -> a
foldlBoard :: forall a b. a -> (a -> b -> a) -> (Int -> b) -> Board -> a
foldlBoard !a
initial !a -> b -> a
foldFn !Int -> b
mapFn = Int -> a -> Board -> a
go Int
0 a
initial
  where
    go :: Int -> a -> Board -> a
go  Int
_ a
acc  Board
0     = a
acc
    go !Int
i !a
acc Board
board = Int -> a -> Board -> a
go (Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
acc' Board
board'
      where
        acc' :: a
acc'    = a -> b -> a
foldFn a
acc (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
$! Int -> b
mapFn Int
i'
        i' :: Int
i'      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
current
        board' :: Board
board'  = (Board
board Board -> Int -> Board
forall a. Bits a => a -> Int -> a
>> Int
current) Board -> Int -> Board
forall a. Bits a => a -> Int -> a
>> Int
1
        current :: Int
current = Board -> Int
lsb Board
board


showBoard :: Board -> String
showBoard :: Board -> String
showBoard Board
board = [String] -> String
forall seq.
(Element seq ~ String, MonoFoldable seq) =>
seq -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Board -> String) -> [Board] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Board -> String
showBin
                          ([Board] -> [String]) -> [Board] -> [String]
forall a b. (a -> b) -> a -> b
$ [Board] -> [Board]
forall seq. SemiSequence seq => seq -> seq
reverse ([Board] -> [Board]) -> [Board] -> [Board]
forall a b. (a -> b) -> a -> b
$ Index [Board] -> [Board] -> [Board]
forall seq. IsSequence seq => Index seq -> seq -> seq
take Int
Index [Board]
8
                          ([Board] -> [Board]) -> [Board] -> [Board]
forall a b. (a -> b) -> a -> b
$ (Board -> Board) -> Board -> [Board]
forall a. (a -> a) -> a -> [a]
iterate (Board -> Int -> Board
forall a. Bits a => a -> Int -> a
>> Int
8) Board
board
  where
    showBin :: Board -> String
showBin Board
w = Element String -> String -> String
forall seq. SemiSequence seq => Element seq -> seq -> seq
intersperse Char
Element String
' ' [Bool -> Char
sb (Board -> Int -> Bool
testSquare Board
w Int
i) | Int
i <- [Int
0 .. Int
7]]
    sb :: Bool -> Char
sb Bool
False = Char
'0'
    sb Bool
True  = Char
'X'


showSquare :: Square -> String
showSquare :: Int -> String
showSquare Int
n = [Vector Char
fileChars Vector Char -> Int -> Char
forall a. Storable a => Vector a -> Int -> a
!! Int -> Int
toFile Int
n, Vector Char
rankChars Vector Char -> Int -> Char
forall a. Storable a => Vector a -> Int -> a
!! Int -> Int
toRank Int
n]
  where
    fileChars :: Vector Char
fileChars = String -> Vector Char
forall a. Storable a => [a] -> Vector a
Vector.fromList [Char
'a' .. Char
'h']
    rankChars :: Vector Char
rankChars = String -> Vector Char
forall a. Storable a => [a] -> Vector a
Vector.fromList [Char
'1' .. Char
'8']


instance Show Move where
  show :: Move -> String
show (Move {Int
Promotion
Piece
$sel:piece:Move :: Move -> Piece
$sel:promotion:Move :: Move -> Promotion
$sel:start:Move :: Move -> Int
$sel:end:Move :: Move -> Int
piece :: Piece
promotion :: Promotion
start :: Int
end :: Int
..}) = Int -> String
showSquare Int
start String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
showSquare Int
end String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Promotion -> String
forall a. Show a => a -> String
show Promotion
promotion