{-|
Module      : Game.Chess
Description : Basic data types and functions related to the game of chess
Copyright   : (c) Mario Lang, 2020
License     : BSD3
Maintainer  : mlang@blind.guru
Stability   : experimental

A small collection of data types and functions to represent Chess positions
and moves including move generation and parsing from external sources.

This module does deliberately not implement
any search or evaluation functionality.  It is intended to be used
to lay the ground for communicating with other programs or players, hence the
package name chessIO.
-}
module Game.Chess.Internal where

import Data.Bits
  ( Bits((.&.), testBit, unsafeShiftR, unsafeShiftL, xor, (.|.), bit, complement),
    FiniteBits(countLeadingZeros, countTrailingZeros) )
import Data.Char ( ord, chr )
import Data.Ix ( Ix(inRange) )
import Data.List (nub, sortOn)
import Data.Maybe ( fromJust, isJust, listToMaybe )
import Data.Ord (Down(..))
import Data.String ( IsString(..) )
import Data.Vector.Unboxed (Vector, (!))
import qualified Data.Vector.Unboxed as Vector
import Data.Word ( Word16, Word64 )
import Foreign.Storable
import Game.Chess.QuadBitboard (QuadBitboard)
import qualified Game.Chess.QuadBitboard as QBB
import Text.Read (readMaybe)

capturing :: Position -> Ply -> Maybe PieceType
capturing :: Position -> Ply -> Maybe PieceType
capturing pos :: Position
pos@Position{Word64
flags :: Position -> Word64
flags :: Word64
flags} (Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
_, Int
to, Maybe PieceType
_))
  | (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask) Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
to = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Pawn
  | Bool
otherwise = (Color, PieceType) -> PieceType
forall a b. (a, b) -> b
snd ((Color, PieceType) -> PieceType)
-> Maybe (Color, PieceType) -> Maybe PieceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> Int -> Maybe (Color, PieceType)
forall sq.
IsSquare sq =>
Position -> sq -> Maybe (Color, PieceType)
pieceAt Position
pos Int
to

isCapture :: Position -> Ply -> Bool
isCapture :: Position -> Ply -> Bool
isCapture Position
pos = Maybe PieceType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PieceType -> Bool)
-> (Ply -> Maybe PieceType) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Ply -> Maybe PieceType
capturing Position
pos

-- | The starting position as given by the FEN string
--   "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1".
startpos :: Position
startpos :: Position
startpos = Maybe Position -> Position
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Position -> Position) -> Maybe Position -> Position
forall a b. (a -> b) -> a -> b
$
  String -> Maybe Position
fromFEN String
"rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1"

data PieceType = Pawn | Knight | Bishop | Rook | Queen | King deriving (PieceType -> PieceType -> Bool
(PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool) -> Eq PieceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PieceType -> PieceType -> Bool
$c/= :: PieceType -> PieceType -> Bool
== :: PieceType -> PieceType -> Bool
$c== :: PieceType -> PieceType -> Bool
Eq, Ord PieceType
Ord PieceType
-> ((PieceType, PieceType) -> [PieceType])
-> ((PieceType, PieceType) -> PieceType -> Int)
-> ((PieceType, PieceType) -> PieceType -> Int)
-> ((PieceType, PieceType) -> PieceType -> Bool)
-> ((PieceType, PieceType) -> Int)
-> ((PieceType, PieceType) -> Int)
-> Ix PieceType
(PieceType, PieceType) -> Int
(PieceType, PieceType) -> [PieceType]
(PieceType, PieceType) -> PieceType -> Bool
(PieceType, PieceType) -> PieceType -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (PieceType, PieceType) -> Int
$cunsafeRangeSize :: (PieceType, PieceType) -> Int
rangeSize :: (PieceType, PieceType) -> Int
$crangeSize :: (PieceType, PieceType) -> Int
inRange :: (PieceType, PieceType) -> PieceType -> Bool
$cinRange :: (PieceType, PieceType) -> PieceType -> Bool
unsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
$cunsafeIndex :: (PieceType, PieceType) -> PieceType -> Int
index :: (PieceType, PieceType) -> PieceType -> Int
$cindex :: (PieceType, PieceType) -> PieceType -> Int
range :: (PieceType, PieceType) -> [PieceType]
$crange :: (PieceType, PieceType) -> [PieceType]
$cp1Ix :: Ord PieceType
Ix, Eq PieceType
Eq PieceType
-> (PieceType -> PieceType -> Ordering)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> PieceType)
-> (PieceType -> PieceType -> PieceType)
-> Ord PieceType
PieceType -> PieceType -> Bool
PieceType -> PieceType -> Ordering
PieceType -> PieceType -> PieceType
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
min :: PieceType -> PieceType -> PieceType
$cmin :: PieceType -> PieceType -> PieceType
max :: PieceType -> PieceType -> PieceType
$cmax :: PieceType -> PieceType -> PieceType
>= :: PieceType -> PieceType -> Bool
$c>= :: PieceType -> PieceType -> Bool
> :: PieceType -> PieceType -> Bool
$c> :: PieceType -> PieceType -> Bool
<= :: PieceType -> PieceType -> Bool
$c<= :: PieceType -> PieceType -> Bool
< :: PieceType -> PieceType -> Bool
$c< :: PieceType -> PieceType -> Bool
compare :: PieceType -> PieceType -> Ordering
$ccompare :: PieceType -> PieceType -> Ordering
$cp1Ord :: Eq PieceType
Ord, Int -> PieceType -> ShowS
[PieceType] -> ShowS
PieceType -> String
(Int -> PieceType -> ShowS)
-> (PieceType -> String)
-> ([PieceType] -> ShowS)
-> Show PieceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PieceType] -> ShowS
$cshowList :: [PieceType] -> ShowS
show :: PieceType -> String
$cshow :: PieceType -> String
showsPrec :: Int -> PieceType -> ShowS
$cshowsPrec :: Int -> PieceType -> ShowS
Show)

data Color = Black | White deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Ord Color
Ord Color
-> ((Color, Color) -> [Color])
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Int)
-> ((Color, Color) -> Color -> Bool)
-> ((Color, Color) -> Int)
-> ((Color, Color) -> Int)
-> Ix Color
(Color, Color) -> Int
(Color, Color) -> [Color]
(Color, Color) -> Color -> Bool
(Color, Color) -> Color -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Color, Color) -> Int
$cunsafeRangeSize :: (Color, Color) -> Int
rangeSize :: (Color, Color) -> Int
$crangeSize :: (Color, Color) -> Int
inRange :: (Color, Color) -> Color -> Bool
$cinRange :: (Color, Color) -> Color -> Bool
unsafeIndex :: (Color, Color) -> Color -> Int
$cunsafeIndex :: (Color, Color) -> Color -> Int
index :: (Color, Color) -> Color -> Int
$cindex :: (Color, Color) -> Color -> Int
range :: (Color, Color) -> [Color]
$crange :: (Color, Color) -> [Color]
$cp1Ix :: Ord Color
Ix, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)

pieceAt :: IsSquare sq => Position -> sq -> Maybe (Color, PieceType)
pieceAt :: Position -> sq -> Maybe (Color, PieceType)
pieceAt Position{QuadBitboard
qbb :: Position -> QuadBitboard
qbb :: QuadBitboard
qbb} (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq) = case QuadBitboard
qbb QuadBitboard -> Int -> Word4
QBB.! Int
sq of
  Word4
QBB.WhitePawn -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Pawn)
  Word4
QBB.WhiteKnight -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Knight)
  Word4
QBB.WhiteBishop -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Bishop)
  Word4
QBB.WhiteRook -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Rook)
  Word4
QBB.WhiteQueen -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
Queen)
  Word4
QBB.WhiteKing -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
White, PieceType
King)
  Word4
QBB.BlackPawn -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Pawn)
  Word4
QBB.BlackKnight -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Knight)
  Word4
QBB.BlackBishop -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Bishop)
  Word4
QBB.BlackRook -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Rook)
  Word4
QBB.BlackQueen -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
Queen)
  Word4
QBB.BlackKing -> (Color, PieceType) -> Maybe (Color, PieceType)
forall a. a -> Maybe a
Just (Color
Black, PieceType
King)
  Word4
_             -> Maybe (Color, PieceType)
forall a. Maybe a
Nothing

opponent :: Color -> Color
opponent :: Color -> Color
opponent Color
White = Color
Black
opponent Color
Black = Color
White

data Piece = Piece !Color !PieceType deriving (Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: 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
showList :: [Piece] -> ShowS
$cshowList :: [Piece] -> ShowS
show :: Piece -> String
$cshow :: Piece -> String
showsPrec :: Int -> Piece -> ShowS
$cshowsPrec :: Int -> Piece -> ShowS
Show)

data Sq = A1 | B1 | C1 | D1 | E1 | F1 | G1 | H1
        | A2 | B2 | C2 | D2 | E2 | F2 | G2 | H2
        | A3 | B3 | C3 | D3 | E3 | F3 | G3 | H3
        | A4 | B4 | C4 | D4 | E4 | F4 | G4 | H4
        | A5 | B5 | C5 | D5 | E5 | F5 | G5 | H5
        | A6 | B6 | C6 | D6 | E6 | F6 | G6 | H6
        | A7 | B7 | C7 | D7 | E7 | F7 | G7 | H7
        | A8 | B8 | C8 | D8 | E8 | F8 | G8 | H8
        deriving (Sq
Sq -> Sq -> Bounded Sq
forall a. a -> a -> Bounded a
maxBound :: Sq
$cmaxBound :: Sq
minBound :: Sq
$cminBound :: Sq
Bounded, Int -> Sq
Sq -> Int
Sq -> [Sq]
Sq -> Sq
Sq -> Sq -> [Sq]
Sq -> Sq -> Sq -> [Sq]
(Sq -> Sq)
-> (Sq -> Sq)
-> (Int -> Sq)
-> (Sq -> Int)
-> (Sq -> [Sq])
-> (Sq -> Sq -> [Sq])
-> (Sq -> Sq -> [Sq])
-> (Sq -> Sq -> Sq -> [Sq])
-> Enum Sq
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Sq -> Sq -> Sq -> [Sq]
$cenumFromThenTo :: Sq -> Sq -> Sq -> [Sq]
enumFromTo :: Sq -> Sq -> [Sq]
$cenumFromTo :: Sq -> Sq -> [Sq]
enumFromThen :: Sq -> Sq -> [Sq]
$cenumFromThen :: Sq -> Sq -> [Sq]
enumFrom :: Sq -> [Sq]
$cenumFrom :: Sq -> [Sq]
fromEnum :: Sq -> Int
$cfromEnum :: Sq -> Int
toEnum :: Int -> Sq
$ctoEnum :: Int -> Sq
pred :: Sq -> Sq
$cpred :: Sq -> Sq
succ :: Sq -> Sq
$csucc :: Sq -> Sq
Enum, Sq -> Sq -> Bool
(Sq -> Sq -> Bool) -> (Sq -> Sq -> Bool) -> Eq Sq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sq -> Sq -> Bool
$c/= :: Sq -> Sq -> Bool
== :: Sq -> Sq -> Bool
$c== :: Sq -> Sq -> Bool
Eq, Ord Sq
Ord Sq
-> ((Sq, Sq) -> [Sq])
-> ((Sq, Sq) -> Sq -> Int)
-> ((Sq, Sq) -> Sq -> Int)
-> ((Sq, Sq) -> Sq -> Bool)
-> ((Sq, Sq) -> Int)
-> ((Sq, Sq) -> Int)
-> Ix Sq
(Sq, Sq) -> Int
(Sq, Sq) -> [Sq]
(Sq, Sq) -> Sq -> Bool
(Sq, Sq) -> Sq -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Sq, Sq) -> Int
$cunsafeRangeSize :: (Sq, Sq) -> Int
rangeSize :: (Sq, Sq) -> Int
$crangeSize :: (Sq, Sq) -> Int
inRange :: (Sq, Sq) -> Sq -> Bool
$cinRange :: (Sq, Sq) -> Sq -> Bool
unsafeIndex :: (Sq, Sq) -> Sq -> Int
$cunsafeIndex :: (Sq, Sq) -> Sq -> Int
index :: (Sq, Sq) -> Sq -> Int
$cindex :: (Sq, Sq) -> Sq -> Int
range :: (Sq, Sq) -> [Sq]
$crange :: (Sq, Sq) -> [Sq]
$cp1Ix :: Ord Sq
Ix, Eq Sq
Eq Sq
-> (Sq -> Sq -> Ordering)
-> (Sq -> Sq -> Bool)
-> (Sq -> Sq -> Bool)
-> (Sq -> Sq -> Bool)
-> (Sq -> Sq -> Bool)
-> (Sq -> Sq -> Sq)
-> (Sq -> Sq -> Sq)
-> Ord Sq
Sq -> Sq -> Bool
Sq -> Sq -> Ordering
Sq -> Sq -> Sq
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
min :: Sq -> Sq -> Sq
$cmin :: Sq -> Sq -> Sq
max :: Sq -> Sq -> Sq
$cmax :: Sq -> Sq -> Sq
>= :: Sq -> Sq -> Bool
$c>= :: Sq -> Sq -> Bool
> :: Sq -> Sq -> Bool
$c> :: Sq -> Sq -> Bool
<= :: Sq -> Sq -> Bool
$c<= :: Sq -> Sq -> Bool
< :: Sq -> Sq -> Bool
$c< :: Sq -> Sq -> Bool
compare :: Sq -> Sq -> Ordering
$ccompare :: Sq -> Sq -> Ordering
$cp1Ord :: Eq Sq
Ord, Int -> Sq -> ShowS
[Sq] -> ShowS
Sq -> String
(Int -> Sq -> ShowS)
-> (Sq -> String) -> ([Sq] -> ShowS) -> Show Sq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sq] -> ShowS
$cshowList :: [Sq] -> ShowS
show :: Sq -> String
$cshow :: Sq -> String
showsPrec :: Int -> Sq -> ShowS
$cshowsPrec :: Int -> Sq -> ShowS
Show)

class IsSquare sq where
  toIndex :: sq -> Int

toRF :: IsSquare sq => sq -> (Int, Int)
toRF :: sq -> (Int, Int)
toRF sq
sq = sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex sq
sq Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
8

toCoord :: (IsSquare sq, IsString s) => sq -> s
toCoord :: sq -> s
toCoord (sq -> (Int, Int)
forall sq. IsSquare sq => sq -> (Int, Int)
toRF -> (Int
r,Int
f)) = String -> s
forall a. IsString a => String -> a
fromString [Int -> Char
chr (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a'), Int -> Char
chr (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'1')]

instance IsSquare Sq where
  toIndex :: Sq -> Int
toIndex = Sq -> Int
forall a. Enum a => a -> Int
fromEnum

instance IsSquare Int where
  toIndex :: Int -> Int
toIndex = Int -> Int
forall a. a -> a
id

isDark :: IsSquare sq => sq -> Bool
isDark :: sq -> Bool
isDark (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq) = (Word64
0xaa55aa55aa55aa55 :: Word64) Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
sq

isLight :: IsSquare sq => sq -> Bool
isLight :: sq -> Bool
isLight = Bool -> Bool
not (Bool -> Bool) -> (sq -> Bool) -> sq -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sq -> Bool
forall sq. IsSquare sq => sq -> Bool
isDark

data Position = Position {
  Position -> QuadBitboard
qbb :: {-# UNPACK #-} !QuadBitboard
, Position -> Color
color :: !Color
  -- ^ active color
, Position -> Word64
flags :: !Word64
, Position -> Int
halfMoveClock :: !Int
, Position -> Int
moveNumber :: !Int
  -- ^ number of the full move
}

-- Article 9.2 states that a position is considered
-- identical to another if the same player is on move, the same types of
-- pieces of the same colors occupy the same squares, and the same moves
-- are available to each player; in particular, each player has the same
-- castling and en passant capturing rights.
instance Eq Position where
  Position
a == :: Position -> Position -> Bool
== Position
b = Position -> QuadBitboard
qbb Position
a QuadBitboard -> QuadBitboard -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> QuadBitboard
qbb Position
b Bool -> Bool -> Bool
&& Position -> Color
color Position
a Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Color
color Position
b Bool -> Bool -> Bool
&& Position -> Word64
flags Position
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Word64
flags Position
b

repetitions :: [Position] -> Maybe (Int, Position)
repetitions :: [Position] -> Maybe (Int, Position)
repetitions [Position]
p = [(Int, Position)] -> Maybe (Int, Position)
forall a. [a] -> Maybe a
listToMaybe ([(Int, Position)] -> Maybe (Int, Position))
-> ([(Int, Position)] -> [(Int, Position)])
-> [(Int, Position)]
-> Maybe (Int, Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Position) -> Down Int)
-> [(Int, Position)] -> [(Int, Position)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((Int, Position) -> Int) -> (Int, Position) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Position) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Position)] -> Maybe (Int, Position))
-> [(Int, Position)] -> Maybe (Int, Position)
forall a b. (a -> b) -> a -> b
$ (Position -> (Int, Position)) -> [Position] -> [(Int, Position)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Position -> (Int, Position)
f ([Position] -> [Position]
forall a. Eq a => [a] -> [a]
nub [Position]
p) where
  f :: Position -> (Int, Position)
f Position
x = (Position -> [Position] -> Int
forall a. Eq a => a -> [a] -> Int
count Position
x [Position]
p, Position
x)
  count :: a -> [a] -> Int
count a
x = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)

instance Show Position where
  show :: Position -> String
show Position
p = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: Position -> String
toFEN Position
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'"']

insufficientMaterial :: Position -> Bool
insufficientMaterial :: Position -> Bool
insufficientMaterial Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} = QuadBitboard -> Bool
QBB.insufficientMaterial QuadBitboard
qbb

-- | Construct a position from Forsyth-Edwards-Notation.
fromFEN :: String -> Maybe Position
fromFEN :: String -> Maybe Position
fromFEN String
fen
  | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
6
  = Maybe Position
forall a. Maybe a
Nothing
  | Bool
otherwise =
    QuadBitboard -> Color -> Word64 -> Int -> Int -> Position
Position (QuadBitboard -> Color -> Word64 -> Int -> Int -> Position)
-> Maybe QuadBitboard
-> Maybe (Color -> Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuadBitboard -> Maybe QuadBitboard
forall a. a -> Maybe a
Just (String -> QuadBitboard
forall a. IsString a => String -> a
fromString ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
0))
             Maybe (Color -> Word64 -> Int -> Int -> Position)
-> Maybe Color -> Maybe (Word64 -> Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Color
forall a. (Eq a, IsString a) => a -> Maybe Color
readColor ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
             Maybe (Word64 -> Int -> Int -> Position)
-> Maybe Word64 -> Maybe (Int -> Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Word64
readFlags ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2) ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
3)
             Maybe (Int -> Int -> Position)
-> Maybe Int -> Maybe (Int -> Position)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
4)
             Maybe (Int -> Position) -> Maybe Int -> Maybe Position
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String]
parts [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
5)
 where
  parts :: [String]
parts = String -> [String]
words String
fen
  readColor :: a -> Maybe Color
readColor a
"w" = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
White
  readColor a
"b" = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
Black
  readColor a
_ = Maybe Color
forall a. Maybe a
Nothing

  readFlags :: String -> String -> Maybe Word64
readFlags String
cst String
ep = Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) (Word64 -> Word64 -> Word64)
-> Maybe Word64 -> Maybe (Word64 -> Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
readCst String
cst Maybe (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Word64
forall a. (Num a, Bits a) => String -> Maybe a
readEP String
ep where
    readCst :: String -> Maybe Word64
readCst String
"-" = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
    readCst String
x = String -> Maybe Word64
go String
x where
      go :: String -> Maybe Word64
go (Char
'K':String
xs) = (Word64
crwKs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go (Char
'Q':String
xs) = (Word64
crwQs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go (Char
'k':String
xs) = (Word64
crbKs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go (Char
'q':String
xs) = (Word64
crbQs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.) (Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word64
go String
xs
      go [] = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
      go String
_ = Maybe Word64
forall a. Maybe a
Nothing
    readEP :: String -> Maybe a
readEP String
"-" = a -> Maybe a
forall a. a -> Maybe a
Just a
0
    readEP [Char
f,Char
r]
      | (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& (Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'3' Bool -> Bool -> Bool
|| Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'6')
      = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Bits a => Int -> a
bit ((Char -> Int
ord Char
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1') Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'))
    readEP String
_ = Maybe a
forall a. Maybe a
Nothing

-- | Convert a position to Forsyth-Edwards-Notation.
toFEN :: Position -> String
toFEN :: Position -> String
toFEN (Position QuadBitboard
bb Color
c Word64
flgs Int
hm Int
mn) = [String] -> String
unwords [
    QuadBitboard -> String
QBB.toString QuadBitboard
bb
  , Color -> String
forall p. IsString p => Color -> p
showColor Color
c, Word64 -> String
showCst (Word64
flgs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` Word64
epMask), Word64 -> String
showEP (Word64
flgs Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask), Int -> String
forall a. Show a => a -> String
show Int
hm, Int -> String
forall a. Show a => a -> String
show Int
mn
  ]
 where
  showColor :: Color -> p
showColor Color
White = p
"w"
  showColor Color
Black = p
"b"
  showCst :: Word64 -> String
showCst Word64
0 = String
"-"
  showCst Word64
x = (Word64, String) -> String
forall a b. (a, b) -> b
snd ((Word64, String) -> String)
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
wks ((Word64, String) -> (Word64, String))
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> (Word64, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
wqs ((Word64, String) -> (Word64, String))
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> (Word64, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
bks ((Word64, String) -> (Word64, String))
-> ((Word64, String) -> (Word64, String))
-> (Word64, String)
-> (Word64, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, String) -> (Word64, String)
bqs ((Word64, String) -> String) -> (Word64, String) -> String
forall a b. (a -> b) -> a -> b
$ (Word64
x, String
"") where
    wks :: (Word64, String) -> (Word64, String)
wks (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Word64
v, Char
'K'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Word64
v, String
xs)
    wqs :: (Word64, String) -> (Word64, String)
wqs (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Word64
v, Char
'Q'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Word64
v, String
xs)
    bks :: (Word64, String) -> (Word64, String)
bks (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Word64
v, Char
'k'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Word64
v, String
xs)
    bqs :: (Word64, String) -> (Word64, String)
bqs (Word64
v, String
xs) | Word64
v Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Word64
v, Char
'q'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)
                | Bool
otherwise          = (Word64
v, String
xs)
  showEP :: Word64 -> String
showEP Word64
0 = String
"-"
  showEP Word64
x = Int -> Char
chr (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a') Char -> ShowS
forall a. a -> [a] -> [a]
: [Int -> Char
chr (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'1')] where
    (Int
r, Int
f) = Int -> (Int, Int)
forall sq. IsSquare sq => sq -> (Int, Int)
toRF (Int -> (Int, Int)) -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
bitScanForward Word64
x

occupiedBy :: Color -> QuadBitboard -> Word64
occupiedBy :: Color -> QuadBitboard -> Word64
occupiedBy Color
White = QuadBitboard -> Word64
QBB.white
occupiedBy Color
Black = QuadBitboard -> Word64
QBB.black

occupied :: QuadBitboard -> Word64
occupied :: QuadBitboard -> Word64
occupied = QuadBitboard -> Word64
QBB.occupied

foldBits :: (a -> Int -> a) -> a -> Word64 -> a
foldBits :: (a -> Int -> a) -> a -> Word64 -> a
foldBits a -> Int -> a
_ a
a Word64
0 = a
a
foldBits a -> Int -> a
f !a
a Word64
n = (a -> Int -> a) -> a -> Word64 -> a
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits a -> Int -> a
f (a -> Int -> a
f a
a (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
n) (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Enum a => a -> a
pred Word64
n

bitScanForward, bitScanReverse :: Word64 -> Int
bitScanForward :: Word64 -> Int
bitScanForward = Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
bitScanReverse :: Word64 -> Int
bitScanReverse = (Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (Word64 -> Int) -> Word64 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros

newtype Ply = Ply Word16 deriving (Ply -> Ply -> Bool
(Ply -> Ply -> Bool) -> (Ply -> Ply -> Bool) -> Eq Ply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ply -> Ply -> Bool
$c/= :: Ply -> Ply -> Bool
== :: Ply -> Ply -> Bool
$c== :: Ply -> Ply -> Bool
Eq, Ptr b -> Int -> IO Ply
Ptr b -> Int -> Ply -> IO ()
Ptr Ply -> IO Ply
Ptr Ply -> Int -> IO Ply
Ptr Ply -> Int -> Ply -> IO ()
Ptr Ply -> Ply -> IO ()
Ply -> Int
(Ply -> Int)
-> (Ply -> Int)
-> (Ptr Ply -> Int -> IO Ply)
-> (Ptr Ply -> Int -> Ply -> IO ())
-> (forall b. Ptr b -> Int -> IO Ply)
-> (forall b. Ptr b -> Int -> Ply -> IO ())
-> (Ptr Ply -> IO Ply)
-> (Ptr Ply -> Ply -> IO ())
-> Storable Ply
forall b. Ptr b -> Int -> IO Ply
forall b. Ptr b -> Int -> Ply -> 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
poke :: Ptr Ply -> Ply -> IO ()
$cpoke :: Ptr Ply -> Ply -> IO ()
peek :: Ptr Ply -> IO Ply
$cpeek :: Ptr Ply -> IO Ply
pokeByteOff :: Ptr b -> Int -> Ply -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Ply -> IO ()
peekByteOff :: Ptr b -> Int -> IO Ply
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Ply
pokeElemOff :: Ptr Ply -> Int -> Ply -> IO ()
$cpokeElemOff :: Ptr Ply -> Int -> Ply -> IO ()
peekElemOff :: Ptr Ply -> Int -> IO Ply
$cpeekElemOff :: Ptr Ply -> Int -> IO Ply
alignment :: Ply -> Int
$calignment :: Ply -> Int
sizeOf :: Ply -> Int
$csizeOf :: Ply -> Int
Storable)

instance Show Ply where
  show :: Ply -> String
show = Ply -> String
toUCI

move :: (IsSquare from, IsSquare to) => from -> to -> Ply
move :: from -> to -> Ply
move (from -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
from) (to -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
to) =
  Word16 -> Ply
Ply (Word16 -> Ply) -> Word16 -> Ply
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
to Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
from Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6

promoteTo :: Ply -> PieceType -> Ply
promoteTo :: Ply -> PieceType -> Ply
promoteTo (Ply Word16
x) = Word16 -> Ply
Ply (Word16 -> Ply) -> (PieceType -> Word16) -> PieceType -> Ply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Word16
set where
  set :: PieceType -> Word16
set PieceType
Knight = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x1000
  set PieceType
Bishop = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x2000
  set PieceType
Rook   = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x3000
  set PieceType
Queen  = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xfff Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x4000
  set PieceType
_      = Word16
x

unpack :: Ply -> (Int, Int, Maybe PieceType)
unpack :: Ply -> (Int, Int, Maybe PieceType)
unpack (Ply Word16
x) = ( Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
                 , Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0b111111)
                 , Maybe PieceType
piece)
 where
  !piece :: Maybe PieceType
piece = case Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
12 of
    Word16
1 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Knight
    Word16
2 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Bishop
    Word16
3 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Rook
    Word16
4 -> PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Queen
    Word16
_ -> Maybe PieceType
forall a. Maybe a
Nothing

fromPolyglot :: Position -> Ply -> Ply
fromPolyglot :: Position -> Ply -> Ply
fromPolyglot Position
pos pl :: Ply
pl@(Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
_)) = case Position -> Color
color Position
pos of
  Color
White | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
        , Position -> Bool
canCastleKingside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
H1
        -> Ply
wKscm
        | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
        , Position -> Bool
canCastleQueenside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
A1
        -> Ply
wQscm
  Color
Black | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
        , Position -> Bool
canCastleKingside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
H8
        -> Ply
bKscm
        | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
        , Position -> Bool
canCastleQueenside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
A8
        -> Ply
bQscm
  Color
_ -> Ply
pl

toPolyglot :: Position -> Ply -> Ply
toPolyglot :: Position -> Ply -> Ply
toPolyglot Position
pos pl :: Ply
pl@(Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
_)) = case Position -> Color
color Position
pos of
  Color
White | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
        , Position -> Bool
canCastleKingside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
G1
        -> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
H1
        | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E1
        , Position -> Bool
canCastleQueenside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
C1
        -> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
A1
  Color
Black | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
        , Position -> Bool
canCastleKingside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
G8
        -> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
H8
        | Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
E8
        , Position -> Bool
canCastleQueenside Position
pos
        , Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex Sq
C8
        -> Int
from Int -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
`move` Sq
A8
  Color
_ -> Ply
pl

-- | Parse a move in the format used by the Universal Chess Interface protocol.
fromUCI :: Position -> String -> Maybe Ply
fromUCI :: Position -> String -> Maybe Ply
fromUCI Position
pos ((String -> (String, String))
-> (String, String) -> (String, (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2) ((String, String) -> (String, (String, String)))
-> (String -> (String, String))
-> String
-> (String, (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
2 -> (String
from, (String
to, String
promo)))
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
promo
  = Int -> Int -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move (Int -> Int -> Ply) -> Maybe Int -> Maybe (Int -> Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
readCoord String
from Maybe (Int -> Ply) -> Maybe Int -> Maybe Ply
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
readCoord String
to Maybe Ply -> (Ply -> Maybe Ply) -> Maybe Ply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
  | Bool
otherwise
  = (\Int
f Int
t PieceType
p -> Int -> Int -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Int
f Int
t Ply -> PieceType -> Ply
`promoteTo` PieceType
p) (Int -> Int -> PieceType -> Ply)
-> Maybe Int -> Maybe (Int -> PieceType -> Ply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
readCoord String
from
                                       Maybe (Int -> PieceType -> Ply)
-> Maybe Int -> Maybe (PieceType -> Ply)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
readCoord String
to
                                       Maybe (PieceType -> Ply) -> Maybe PieceType -> Maybe Ply
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe PieceType
forall a. (Eq a, IsString a) => a -> Maybe PieceType
readPromo String
promo
      Maybe Ply -> (Ply -> Maybe Ply) -> Maybe Ply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Position -> Ply -> Maybe Ply
relativeTo Position
pos
 where
  readCoord :: String -> Maybe Int
readCoord [Char
f,Char
r]
    | (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'a',Char
'h') Char
f Bool -> Bool -> Bool
&& (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1',Char
'8') Char
r
    = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
ord Char
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'1') Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a')
  readCoord String
_ = Maybe Int
forall a. Maybe a
Nothing
  readPromo :: a -> Maybe PieceType
readPromo a
"q" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Queen
  readPromo a
"r" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Rook
  readPromo a
"b" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Bishop
  readPromo a
"n" = PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just PieceType
Knight
  readPromo a
_ = Maybe PieceType
forall a. Maybe a
Nothing

-- | Convert a move to the format used by the Universal Chess Interface protocol.
toUCI :: Ply -> String
toUCI :: Ply -> String
toUCI (Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
promo)) = Int -> String
forall sq. IsSquare sq => sq -> String
coord Int
from String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall sq. IsSquare sq => sq -> String
coord Int
to String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p where
  coord :: sq -> String
coord sq
x = let (Int
r,Int
f) = sq -> (Int, Int)
forall sq. IsSquare sq => sq -> (Int, Int)
toRF sq
x in
            Int -> Char
chr (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a') Char -> ShowS
forall a. a -> [a] -> [a]
: [Int -> Char
chr (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'1')]
  p :: String
p = case Maybe PieceType
promo of
    Just PieceType
Queen -> String
"q"
    Just PieceType
Rook -> String
"r"
    Just PieceType
Bishop -> String
"b"
    Just PieceType
Knight -> String
"n"
    Maybe PieceType
_ -> String
""

-- | Validate that a certain move is legal in the given position.
relativeTo :: Position -> Ply -> Maybe Ply
relativeTo :: Position -> Ply -> Maybe Ply
relativeTo Position
pos Ply
m | Ply
m Ply -> [Ply] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Position -> [Ply]
legalPlies Position
pos = Ply -> Maybe Ply
forall a. a -> Maybe a
Just Ply
m
                 | Bool
otherwise = Maybe Ply
forall a. Maybe a
Nothing

shiftN, shiftNNE, shiftNE, shiftENE, shiftE, shiftESE, shiftSE, shiftSSE, shiftS, shiftSSW, shiftSW, shiftWSW, shiftW, shiftWNW, shiftNW, shiftNNW :: Word64 -> Word64
shiftN :: Word64 -> Word64
shiftN   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
shiftNNE :: Word64 -> Word64
shiftNNE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftNE :: Word64 -> Word64
shiftNE  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
9 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftENE :: Word64 -> Word64
shiftENE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
10 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftE :: Word64 -> Word64
shiftE   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftESE :: Word64 -> Word64
shiftESE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notABFile
shiftSE :: Word64 -> Word64
shiftSE  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftSSE :: Word64 -> Word64
shiftSSE Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
15 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notAFile
shiftS :: Word64 -> Word64
shiftS   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8
shiftSSW :: Word64 -> Word64
shiftSSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
17 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftSW :: Word64 -> Word64
shiftSW  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
9 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWSW :: Word64 -> Word64
shiftWSW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
10 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftW :: Word64 -> Word64
shiftW   Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftWNW :: Word64 -> Word64
shiftWNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
6 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notGHFile
shiftNW :: Word64 -> Word64
shiftNW  Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile
shiftNNW :: Word64 -> Word64
shiftNNW Word64
w = Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
15 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notHFile

-- | Apply a move to the given position.
--
-- This function checks if the move is actually legal and throws and error
-- if it isn't.  See 'unsafeDoPly' for a version that omits the legality check.
doPly :: Position -> Ply -> Position
doPly :: Position -> Ply -> Position
doPly Position
p Ply
m
  | Ply
m Ply -> [Ply] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Position -> [Ply]
legalPlies Position
p = Position -> Ply -> Position
unsafeDoPly Position
p Ply
m
  | Bool
otherwise        = String -> Position
forall a. HasCallStack => String -> a
error String
"Game.Chess.doPly: Illegal move"

-- | An unsafe version of 'doPly'.  Only use this if you are sure the given move
-- can be applied to the position.  This is useful if the move has been generated
-- by the 'moves' function.
unsafeDoPly :: Position -> Ply -> Position
unsafeDoPly :: Position -> Ply -> Position
unsafeDoPly pos :: Position
pos@Position{color :: Position -> Color
color = Color
White, Int
halfMoveClock :: Int
halfMoveClock :: Position -> Int
halfMoveClock} Ply
m =
  (Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
m) { color :: Color
color = Color
Black, halfMoveClock :: Int
halfMoveClock = Int -> Int
forall a. Enum a => a -> a
succ Int
halfMoveClock }
unsafeDoPly pos :: Position
pos@Position{color :: Position -> Color
color = Color
Black, Int
moveNumber :: Int
moveNumber :: Position -> Int
moveNumber, Int
halfMoveClock :: Int
halfMoveClock :: Position -> Int
halfMoveClock} Ply
m =
  (Position -> Ply -> Position
unsafeDoPly' Position
pos Ply
m) { color :: Color
color = Color
White, moveNumber :: Int
moveNumber = Int -> Int
forall a. Enum a => a -> a
succ Int
moveNumber, halfMoveClock :: Int
halfMoveClock = Int -> Int
forall a. Enum a => a -> a
succ Int
halfMoveClock }

unsafeDoPly' :: Position -> Ply -> Position
unsafeDoPly' :: Position -> Ply -> Position
unsafeDoPly' pos :: Position
pos@Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} m :: Ply
m@(Ply -> (Int, Int, Maybe PieceType)
unpack -> (Int
from, Int
to, Maybe PieceType
promo))
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
wKscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.whiteKingsideCastle
        , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
wQscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.whiteQueensideCastle
        , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
bKscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.blackKingsideCastle
        , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Ply
m Ply -> Ply -> Bool
forall a. Eq a => a -> a -> Bool
== Ply
bQscm Bool -> Bool -> Bool
&& Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> QuadBitboard
QBB.blackQueensideCastle
        , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
rank8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
epMask)
        }
  | Just PieceType
piece <- Maybe PieceType
promo
  = case Position -> Color
color Position
pos of
      Color
White -> case PieceType
piece of
        PieceType
Queen -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteQueen
                     , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                     }
        PieceType
Rook  -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteRook
                     , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                     }
        PieceType
Bishop -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteBishop
                      , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                      }
        PieceType
Knight -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.whitePromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.WhiteKnight
                      , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                      }
        PieceType
_ -> String -> Position
forall a. HasCallStack => String -> a
error String
"Impossible: White tried to promote to Pawn"
      Color
Black -> case PieceType
piece of
        PieceType
Queen -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackQueen
                     , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                     }  
        PieceType
Rook   -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackRook
                      , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                      }
        PieceType
Bishop -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackBishop
                      , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                      }
        PieceType
Knight -> Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> Word4 -> QuadBitboard
QBB.blackPromotion QuadBitboard
qbb Int
from Int
to Word4
QBB.BlackKnight
                      , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64
forall a. Bits a => Int -> a
bit Int
to)
                      }
        PieceType
_ -> String -> Position
forall a. HasCallStack => String -> a
error String
"Impossible: Black tried to promote to Pawn"
  | QuadBitboard -> Word64
QBB.pawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
fromMask Bool -> Bool -> Bool
&&
    Word64
toMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
rank3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
rank6) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
flags Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard
qbb QuadBitboard -> QuadBitboard -> QuadBitboard
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> QuadBitboard
QBB.enPassant Int
from Int
to
        , flags :: Word64
flags = Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` Word64
toMask
        }
  | Bool
otherwise
  = Position
pos { qbb :: QuadBitboard
qbb = QuadBitboard -> Int -> Int -> QuadBitboard
QBB.move QuadBitboard
qbb Int
from Int
to
        , flags :: Word64
flags = (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`clearMask` (Word64
epMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
mask)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
dpp
        }
 where
  !fromMask :: Word64
fromMask = Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
from
  !toMask :: Word64
toMask = Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
to
  !mask :: Word64
mask = Word64
fromMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
toMask
  dpp :: Word64
dpp = case Position -> Color
color Position
pos of
    Color
White | Word64
fromMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank2 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 Bool -> Bool -> Bool
&& Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
to -> Word64 -> Word64
shiftN Word64
fromMask
    Color
Black | Word64
fromMask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank7 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 Bool -> Bool -> Bool
&& Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
to -> Word64 -> Word64
shiftS Word64
fromMask
    Color
_                                                            -> Word64
0

-- | Generate a list of possible moves for the given position.
legalPlies :: Position -> [Ply]
legalPlies :: Position -> [Ply]
legalPlies pos :: Position
pos@Position{Color
color :: Color
color :: Position -> Color
color, QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, Word64
flags :: Word64
flags :: Position -> Word64
flags} = (Ply -> Bool) -> [Ply] -> [Ply]
forall a. (a -> Bool) -> [a] -> [a]
filter Ply -> Bool
legalPly ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall a b. (a -> b) -> a -> b
$
      [Ply] -> [Ply]
kingMoves
    ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
knightMoves
    ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
Queen Position
pos Word64
notOurs Word64
occ
    ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
Rook Position
pos Word64
notOurs Word64
occ
    ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
Bishop Position
pos Word64
notOurs Word64
occ
    ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
pawnMoves
    ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall a b. (a -> b) -> a -> b
$ []
 where
  legalPly :: Ply -> Bool
legalPly = Bool -> Bool
not (Bool -> Bool) -> (Ply -> Bool) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Position -> Bool
inCheck Color
color (Position -> Bool) -> (Ply -> Position) -> Ply -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Ply -> Position
unsafeDoPly' Position
pos
  !ours :: Word64
ours = Color -> QuadBitboard -> Word64
occupiedBy Color
color QuadBitboard
qbb
  !them :: Word64
them = Color -> QuadBitboard -> Word64
occupiedBy (Color -> Color
opponent Color
color) QuadBitboard
qbb
  !notOurs :: Word64
notOurs = Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
ours
  !occ :: Word64
occ = Word64
ours Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
them
  (![Ply] -> [Ply]
pawnMoves, ![Ply] -> [Ply]
knightMoves, ![Ply] -> [Ply]
kingMoves) = case Color
color of
    Color
White ->
      ( Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
wPawnMoves (QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb) (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
occ) (Word64
them Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask))
      , ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genNMoves) (QuadBitboard -> Word64
QBB.wKnights QuadBitboard
qbb)
      , ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genKMoves) (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb) ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
wShort ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
wLong)
    Color
Black ->
      ( Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
bPawnMoves (QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb) (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
occ) (Word64
them Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
flags Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
epMask))
      , ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genNMoves) (QuadBitboard -> Word64
QBB.bKnights QuadBitboard
qbb)
      , ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
genKMoves) (QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb) ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
bShort ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ply] -> [Ply]
bLong)
  genNMoves :: [Ply] -> Int -> [Ply]
genNMoves [Ply]
ms Int
sq = ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (Int -> [Ply] -> Int -> [Ply]
forall from to.
(IsSquare from, IsSquare to) =>
from -> [Ply] -> to -> [Ply]
mkM Int
sq) [Ply]
ms ((Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs)
  genKMoves :: [Ply] -> Int -> [Ply]
genKMoves [Ply]
ms Int
sq = ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (Int -> [Ply] -> Int -> [Ply]
forall from to.
(IsSquare from, IsSquare to) =>
from -> [Ply] -> to -> [Ply]
mkM Int
sq) [Ply]
ms ((Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs)
  wShort :: [Ply] -> [Ply]
wShort [Ply]
ml | Position -> Word64 -> Bool
canCastleKingside' Position
pos Word64
occ = Ply
wKscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
            | Bool
otherwise             = [Ply]
ml
  wLong :: [Ply] -> [Ply]
wLong [Ply]
ml  | Position -> Word64 -> Bool
canCastleQueenside' Position
pos Word64
occ = Ply
wQscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
            | Bool
otherwise                   = [Ply]
ml
  bShort :: [Ply] -> [Ply]
bShort [Ply]
ml | Position -> Word64 -> Bool
canCastleKingside' Position
pos Word64
occ = Ply
bKscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
            | Bool
otherwise                  = [Ply]
ml
  bLong :: [Ply] -> [Ply]
bLong [Ply]
ml  | Position -> Word64 -> Bool
canCastleQueenside' Position
pos Word64
occ = Ply
bQscm Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ml
            | Bool
otherwise              = [Ply]
ml
  mkM :: from -> [Ply] -> to -> [Ply]
mkM !from
from [Ply]
ms !to
to = from -> to -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move from
from to
to Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms

-- | Returns 'True' if 'Color' is in check in the given position.
inCheck :: Color -> Position -> Bool
inCheck :: Color -> Position -> Bool
inCheck Color
White Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} =
  Color -> QuadBitboard -> Word64 -> Int -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
Black QuadBitboard
qbb (QuadBitboard -> Word64
occupied QuadBitboard
qbb) (Word64 -> Int
bitScanForward (QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb))
inCheck Color
Black Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} =
  Color -> QuadBitboard -> Word64 -> Int -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb (QuadBitboard -> Word64
occupied QuadBitboard
qbb) (Word64 -> Int
bitScanForward (QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb))

wPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
wPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
wPawnMoves !Word64
pawns !Word64
emptySquares !Word64
opponentPieces =
    ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
9) Word64
eastCaptureTargets
  ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
7) Word64
westCaptureTargets
  ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
8) Word64
singlePushTargets
  ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
16) Word64
doublePushTargets
 where
  doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftN Word64
singlePushTargets Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank4
  singlePushTargets :: Word64
singlePushTargets = Word64 -> Word64
shiftN Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares
  eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftNE Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
  westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftNW Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
  mkPly :: a -> [Ply] -> a -> [Ply]
mkPly a
diff [Ply]
ms a
tsq
    | a
tsq a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
56 = (Ply -> PieceType -> Ply
promoteTo Ply
m (PieceType -> Ply) -> [PieceType] -> [Ply]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight]) [Ply] -> [Ply] -> [Ply]
forall a. Semigroup a => a -> a -> a
<> [Ply]
ms
    | Bool
otherwise = Ply
m Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
   where m :: Ply
m = a -> a -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move (a
tsq a -> a -> a
forall a. Num a => a -> a -> a
- a
diff) a
tsq

bPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
bPawnMoves :: Word64 -> Word64 -> Word64 -> [Ply] -> [Ply]
bPawnMoves !Word64
pawns !Word64
emptySquares !Word64
opponentPieces =
    ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
9) Word64
westCaptureTargets
  ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
7) Word64
eastCaptureTargets
  ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
8) Word64
singlePushTargets
  ([Ply] -> [Ply]) -> ([Ply] -> [Ply]) -> [Ply] -> [Ply]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply])
-> ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a b. (a -> b) -> a -> b
$ Int -> [Ply] -> Int -> [Ply]
forall a. (IsSquare a, Num a, Ord a) => a -> [Ply] -> a -> [Ply]
mkPly Int
16) Word64
doublePushTargets
 where
  doublePushTargets :: Word64
doublePushTargets = Word64 -> Word64
shiftS Word64
singlePushTargets Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
rank5
  singlePushTargets :: Word64
singlePushTargets = Word64 -> Word64
shiftS Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
emptySquares
  eastCaptureTargets :: Word64
eastCaptureTargets = Word64 -> Word64
shiftSE Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
  westCaptureTargets :: Word64
westCaptureTargets = Word64 -> Word64
shiftSW Word64
pawns Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
opponentPieces
  mkPly :: a -> [Ply] -> a -> [Ply]
mkPly a
diff [Ply]
ms a
tsq
    | a
tsq a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
7  = (Ply -> PieceType -> Ply
promoteTo Ply
m (PieceType -> Ply) -> [PieceType] -> [Ply]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PieceType
Queen, PieceType
Rook, PieceType
Bishop, PieceType
Knight]) [Ply] -> [Ply] -> [Ply]
forall a. Semigroup a => a -> a -> a
<> [Ply]
ms
    | Bool
otherwise = Ply
m Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
   where m :: Ply
m = a -> a -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move (a
tsq a -> a -> a
forall a. Num a => a -> a -> a
+ a
diff) a
tsq

slideMoves :: PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves :: PieceType -> Position -> Word64 -> Word64 -> [Ply] -> [Ply]
slideMoves PieceType
piece (Position QuadBitboard
bb Color
c Word64
_ Int
_ Int
_) !Word64
notOurs !Word64
occ =
  ([Ply] -> Word64 -> [Ply]) -> Word64 -> [Ply] -> [Ply]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits [Ply] -> Int -> [Ply]
gen) Word64
pieces
 where
  gen :: [Ply] -> Int -> [Ply]
gen [Ply]
ms Int
from = ([Ply] -> Int -> [Ply]) -> [Ply] -> Word64 -> [Ply]
forall a. (a -> Int -> a) -> a -> Word64 -> a
foldBits (Int -> [Ply] -> Int -> [Ply]
forall from to.
(IsSquare from, IsSquare to) =>
from -> [Ply] -> to -> [Ply]
mkPly Int
from) [Ply]
ms (Int -> Word64
targets Int
from)
  mkPly :: from -> [Ply] -> to -> [Ply]
mkPly from
from [Ply]
ms to
to = from -> to -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move from
from to
to Ply -> [Ply] -> [Ply]
forall a. a -> [a] -> [a]
: [Ply]
ms
  targets :: Int -> Word64
targets Int
sq = case PieceType
piece of
    PieceType
Rook -> Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs
    PieceType
Bishop -> Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs
    PieceType
Queen -> Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
notOurs
    PieceType
_ -> String -> Word64
forall a. HasCallStack => String -> a
error String
"Not a sliding piece"
  pieces :: Word64
pieces = case (Color
c, PieceType
piece) of
    (Color
White, PieceType
Bishop) -> QuadBitboard -> Word64
QBB.wBishops QuadBitboard
bb
    (Color
Black, PieceType
Bishop) -> QuadBitboard -> Word64
QBB.bBishops QuadBitboard
bb
    (Color
White, PieceType
Rook)   -> QuadBitboard -> Word64
QBB.wRooks QuadBitboard
bb
    (Color
Black, PieceType
Rook)   -> QuadBitboard -> Word64
QBB.bRooks QuadBitboard
bb
    (Color
White, PieceType
Queen)  -> QuadBitboard -> Word64
QBB.wQueens QuadBitboard
bb
    (Color
Black, PieceType
Queen)  -> QuadBitboard -> Word64
QBB.bQueens QuadBitboard
bb
    (Color, PieceType)
_ -> Word64
0

data Castle = Kingside | Queenside deriving (Castle -> Castle -> Bool
(Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool) -> Eq Castle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Castle -> Castle -> Bool
$c/= :: Castle -> Castle -> Bool
== :: Castle -> Castle -> Bool
$c== :: Castle -> Castle -> Bool
Eq, Ord Castle
Ord Castle
-> ((Castle, Castle) -> [Castle])
-> ((Castle, Castle) -> Castle -> Int)
-> ((Castle, Castle) -> Castle -> Int)
-> ((Castle, Castle) -> Castle -> Bool)
-> ((Castle, Castle) -> Int)
-> ((Castle, Castle) -> Int)
-> Ix Castle
(Castle, Castle) -> Int
(Castle, Castle) -> [Castle]
(Castle, Castle) -> Castle -> Bool
(Castle, Castle) -> Castle -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Castle, Castle) -> Int
$cunsafeRangeSize :: (Castle, Castle) -> Int
rangeSize :: (Castle, Castle) -> Int
$crangeSize :: (Castle, Castle) -> Int
inRange :: (Castle, Castle) -> Castle -> Bool
$cinRange :: (Castle, Castle) -> Castle -> Bool
unsafeIndex :: (Castle, Castle) -> Castle -> Int
$cunsafeIndex :: (Castle, Castle) -> Castle -> Int
index :: (Castle, Castle) -> Castle -> Int
$cindex :: (Castle, Castle) -> Castle -> Int
range :: (Castle, Castle) -> [Castle]
$crange :: (Castle, Castle) -> [Castle]
$cp1Ix :: Ord Castle
Ix, Eq Castle
Eq Castle
-> (Castle -> Castle -> Ordering)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Bool)
-> (Castle -> Castle -> Castle)
-> (Castle -> Castle -> Castle)
-> Ord Castle
Castle -> Castle -> Bool
Castle -> Castle -> Ordering
Castle -> Castle -> Castle
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
min :: Castle -> Castle -> Castle
$cmin :: Castle -> Castle -> Castle
max :: Castle -> Castle -> Castle
$cmax :: Castle -> Castle -> Castle
>= :: Castle -> Castle -> Bool
$c>= :: Castle -> Castle -> Bool
> :: Castle -> Castle -> Bool
$c> :: Castle -> Castle -> Bool
<= :: Castle -> Castle -> Bool
$c<= :: Castle -> Castle -> Bool
< :: Castle -> Castle -> Bool
$c< :: Castle -> Castle -> Bool
compare :: Castle -> Castle -> Ordering
$ccompare :: Castle -> Castle -> Ordering
$cp1Ord :: Eq Castle
Ord, Int -> Castle -> ShowS
[Castle] -> ShowS
Castle -> String
(Int -> Castle -> ShowS)
-> (Castle -> String) -> ([Castle] -> ShowS) -> Show Castle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Castle] -> ShowS
$cshowList :: [Castle] -> ShowS
show :: Castle -> String
$cshow :: Castle -> String
showsPrec :: Int -> Castle -> ShowS
$cshowsPrec :: Int -> Castle -> ShowS
Show)

castlingRights :: Position -> [(Color, Castle)]
castlingRights :: Position -> [(Color, Castle)]
castlingRights Position{Word64
flags :: Word64
flags :: Position -> Word64
flags} = [(Color, Castle)] -> [(Color, Castle)]
wks ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
wqs ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bks ([(Color, Castle)] -> [(Color, Castle)])
-> ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)]
-> [(Color, Castle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Castle)] -> [(Color, Castle)]
bqs ([(Color, Castle)] -> [(Color, Castle)])
-> [(Color, Castle)] -> [(Color, Castle)]
forall a b. (a -> b) -> a -> b
$ [] where
  wks :: [(Color, Castle)] -> [(Color, Castle)]
wks [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs = (Color
White, Castle
Kingside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  wqs :: [(Color, Castle)] -> [(Color, Castle)]
wqs [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs = (Color
White, Castle
Queenside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  bks :: [(Color, Castle)] -> [(Color, Castle)]
bks [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs = (Color
Black, Castle
Kingside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs
  bqs :: [(Color, Castle)] -> [(Color, Castle)]
bqs [(Color, Castle)]
xs | Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs = (Color
Black, Castle
Queenside)(Color, Castle) -> [(Color, Castle)] -> [(Color, Castle)]
forall a. a -> [a] -> [a]
:[(Color, Castle)]
xs
         | Bool
otherwise              = [(Color, Castle)]
xs

canCastleKingside, canCastleQueenside :: Position -> Bool
canCastleKingside :: Position -> Bool
canCastleKingside pos :: Position
pos@Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} = Position -> Word64 -> Bool
canCastleKingside' Position
pos (QuadBitboard -> Word64
occupied QuadBitboard
qbb)
canCastleQueenside :: Position -> Bool
canCastleQueenside pos :: Position
pos@Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb} = Position -> Word64 -> Bool
canCastleQueenside' Position
pos (QuadBitboard -> Word64
occupied QuadBitboard
qbb)

canCastleKingside', canCastleQueenside' :: Position -> Word64 -> Bool
canCastleKingside' :: Position -> Word64 -> Bool
canCastleKingside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
White, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwKs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crwKe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
Black QuadBitboard
qbb Word64
occ) [Sq
E1, Sq
F1, Sq
G1])
canCastleKingside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
Black, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ = 
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbKs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crbKe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb Word64
occ) [Sq
E8, Sq
F8, Sq
G8])
canCastleQueenside' :: Position -> Word64 -> Bool
canCastleQueenside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
White, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crwQs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crwQe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
Black QuadBitboard
qbb Word64
occ) [Sq
E1, Sq
D1, Sq
C1])
canCastleQueenside' Position{QuadBitboard
qbb :: QuadBitboard
qbb :: Position -> QuadBitboard
qbb, color :: Position -> Color
color = Color
Black, Word64
flags :: Word64
flags :: Position -> Word64
flags} !Word64
occ =
  Word64
flags Word64 -> Word64 -> Bool
forall a. Bits a => a -> a -> Bool
`testMask` Word64
crbQs Bool -> Bool -> Bool
&& Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
crbQe Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&&
  Bool -> Bool
not ((Sq -> Bool) -> [Sq] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Color -> QuadBitboard -> Word64 -> Sq -> Bool
forall sq.
IsSquare sq =>
Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb Word64
occ) [Sq
E8, Sq
D8, Sq
C8])

wKscm, wQscm, bKscm, bQscm :: Ply
wKscm :: Ply
wKscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E1 Sq
G1
wQscm :: Ply
wQscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E1 Sq
C1
bKscm :: Ply
bKscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E8 Sq
G8
bQscm :: Ply
bQscm = Sq -> Sq -> Ply
forall from to. (IsSquare from, IsSquare to) => from -> to -> Ply
move Sq
E8 Sq
C8

attackedBy :: IsSquare sq => Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy :: Color -> QuadBitboard -> Word64 -> sq -> Bool
attackedBy Color
White QuadBitboard
qbb !Word64
occ (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq)
  | (Vector Word64
wPawnAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | (Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKnights QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wBishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Word64
QBB.wRooks QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wQueens QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | (Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.wKings QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0   = Bool
True
  | Bool
otherwise                        = Bool
False
attackedBy Color
Black QuadBitboard
qbb !Word64
occ (sq -> Int
forall sq. IsSquare sq => sq -> Int
toIndex -> Int
sq)
  | (Vector Word64
bPawnAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bPawns QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | (Vector Word64
knightAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKnights QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bBishops QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.   QuadBitboard -> Word64
QBB.bRooks QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&.  QuadBitboard -> Word64
QBB.bQueens QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0 = Bool
True
  | (Vector Word64
kingAttacks Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. QuadBitboard -> Word64
QBB.bKings QuadBitboard
qbb Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0   = Bool
True
  | Bool
otherwise                        = Bool
False

notAFile, notABFile, notGHFile, notHFile, rank1, rank2, rank3, rank4, rank5, rank6, rank7, rank8 :: Word64
notAFile :: Word64
notAFile = Word64
0xfefefefefefefefe
notABFile :: Word64
notABFile = Word64
0xfcfcfcfcfcfcfcfc
notGHFile :: Word64
notGHFile = Word64
0x3f3f3f3f3f3f3f3f
notHFile :: Word64
notHFile = Word64
0x7f7f7f7f7f7f7f7f
rank1 :: Word64
rank1 = Word64
0x00000000000000ff
rank2 :: Word64
rank2 = Word64
0x000000000000ff00
rank3 :: Word64
rank3 = Word64
0x0000000000ff0000
rank4 :: Word64
rank4 = Word64
0x00000000ff000000
rank5 :: Word64
rank5 = Word64
0x000000ff00000000
rank6 :: Word64
rank6 = Word64
0x0000ff0000000000
rank7 :: Word64
rank7 = Word64
0x00ff000000000000
rank8 :: Word64
rank8 = Word64
0xff00000000000000

epMask, crwKs, crwQs, crwKe, crwQe, crbKs, crbQs, crbKe, crbQe :: Word64
epMask :: Word64
epMask = Word64
rank3 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
rank6        -- mask for en passant
crwKs :: Word64
crwKs  = Word64
0x0000000000000090     -- white: king & rook position for kingside castle
crwQs :: Word64
crwQs  = Word64
0x0000000000000011     -- white: king & rook pisition for queenside castle^M
crwKe :: Word64
crwKe  = Word64
0x0000000000000060     -- white: empty fields for kingside castle
crwQe :: Word64
crwQe  = Word64
0x000000000000000e     -- white: empty fields for queenside castle
crbKs :: Word64
crbKs  = Word64
0x9000000000000000     -- black: king & rook position for kingside castle
crbQs :: Word64
crbQs  = Word64
0x1100000000000000     -- black: king & rook position for queenside castle^M
crbKe :: Word64
crbKe  = Word64
0x6000000000000000     -- black: empty fields for kingside castle
crbQe :: Word64
crbQe  = Word64
0x0e00000000000000     -- black: empty fields for queenside castle

kingAttacks, knightAttacks, wPawnAttacks, bPawnAttacks :: Vector Word64
kingAttacks :: Vector Word64
kingAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftN Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftS Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNW Word64
b
knightAttacks :: Vector Word64
knightAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftNNE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftENE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftESE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSSE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftSSW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftWSW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
  Word64 -> Word64
shiftWNW Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNNW Word64
b
wPawnAttacks :: Vector Word64
wPawnAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftSE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftSW Word64
b
bPawnAttacks :: Vector Word64
bPawnAttacks = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq -> let b :: Word64
b = Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq in
  Word64 -> Word64
shiftNE Word64
b Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Word64
shiftNW Word64
b

data Direction = N | NE | E | SE | S | SW | W | NW deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)

rookTargets, bishopTargets, queenTargets :: Int -> Word64 -> Word64
rookTargets :: Int -> Word64 -> Word64
rookTargets !Int
sq !Word64
occ = Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
N Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
E Word64
occ
                   Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
S Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
W Word64
occ
bishopTargets :: Int -> Word64 -> Word64
bishopTargets !Int
sq !Word64
occ = Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
NW Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
NE Word64
occ
                     Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
SE Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
SW Word64
occ
queenTargets :: Int -> Word64 -> Word64
queenTargets Int
sq Word64
occ = Int -> Word64 -> Word64
rookTargets Int
sq Word64
occ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int -> Word64 -> Word64
bishopTargets Int
sq Word64
occ

getRayTargets :: Int -> Direction -> Word64 -> Word64
getRayTargets :: Int -> Direction -> Word64 -> Word64
getRayTargets Int
sq Direction
dir Word64
occ = Word64 -> Word64
blocked (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
attacks Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
occ where
  blocked :: Word64 -> Word64
blocked Word64
0 = Word64
attacks
  blocked Word64
bb = Word64
attacks Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` (Vector Word64
ray Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Word64 -> Int
bitScan Word64
bb)
  attacks :: Word64
attacks = Vector Word64
ray Vector Word64 -> Int -> Word64
forall a. Unbox a => Vector a -> Int -> a
! Int
sq
  (Word64 -> Int
bitScan, Vector Word64
ray) = case Direction
dir of
    Direction
NW -> (Word64 -> Int
bitScanForward, Vector Word64
attackNW)
    Direction
N  -> (Word64 -> Int
bitScanForward, Vector Word64
attackN)
    Direction
NE -> (Word64 -> Int
bitScanForward, Vector Word64
attackNE)
    Direction
E  -> (Word64 -> Int
bitScanForward, Vector Word64
attackE)
    Direction
SE -> (Word64 -> Int
bitScanReverse, Vector Word64
attackSE)
    Direction
S  -> (Word64 -> Int
bitScanReverse, Vector Word64
attackS)
    Direction
SW -> (Word64 -> Int
bitScanReverse, Vector Word64
attackSW)
    Direction
W  -> (Word64 -> Int
bitScanReverse, Vector Word64
attackW)

attackDir :: (Word64 -> Word64) -> Vector Word64
attackDir :: (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
s = Int -> (Int -> Word64) -> Vector Word64
forall a. Unbox a => Int -> (Int -> a) -> Vector a
Vector.generate Int
64 ((Int -> Word64) -> Vector Word64)
-> (Int -> Word64) -> Vector Word64
forall a b. (a -> b) -> a -> b
$ \Int
sq ->
  (Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> Word64
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
(.|.) Word64
0 ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
7 ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64]
forall a. [a] -> [a]
tail ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> Word64 -> [Word64]
forall a. (a -> a) -> a -> [a]
iterate Word64 -> Word64
s (Int -> Word64
forall a. Bits a => Int -> a
bit Int
sq)

attackNW, attackN, attackNE, attackE, attackSE, attackS, attackSW, attackW :: Vector Word64
attackNW :: Vector Word64
attackNW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftNW
attackN :: Vector Word64
attackN  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftN
attackNE :: Vector Word64
attackNE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftNE
attackE :: Vector Word64
attackE  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftE
attackSE :: Vector Word64
attackSE = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftSE
attackS :: Vector Word64
attackS  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftS
attackSW :: Vector Word64
attackSW = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftSW
attackW :: Vector Word64
attackW  = (Word64 -> Word64) -> Vector Word64
attackDir Word64 -> Word64
shiftW

clearMask :: Bits a => a -> a -> a
clearMask :: a -> a -> a
clearMask a
a a
b = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement a
b

testMask :: Bits a => a -> a -> Bool
testMask :: a -> a -> Bool
testMask a
a a
b = a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b

{-# INLINE clearMask #-}
{-# INLINE testMask #-}
{-# INLINE attackedBy #-}
{-# INLINE slideMoves #-}
{-# INLINE wPawnMoves #-}
{-# INLINE bPawnMoves #-}
{-# INLINE unpack #-}
{-# INLINE foldBits #-}
{-# INLINE bitScanForward #-}
{-# INLINE bitScanReverse #-}