module Parsers.Position (positionFenParser, squareParser) where

import           AppPrelude

import           Bookhound.Parser
import           Bookhound.ParserCombinators
import           Bookhound.Parsers.Char      (space)
import           Bookhound.Parsers.Number    (unsignedInt)
import           Data.Char                   (digitToInt)

import           Models.Piece
import           Models.Position
import           Models.Score
import           MoveGen.MakeMove
import           Utils.Board


positionFenParser :: Parser Position
positionFenParser :: Parser Position
positionFenParser = do
  ([(Square, (Piece, Color))]
pieces, Color
color, [(CastlingRights, Color)]
castling, Maybe Square
enPassant, Ply
halfMoveClock, Square
_) <- Parser
  ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
   Maybe Square, Ply, Square)
position
  Position -> Parser Position
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Position -> Parser Position) -> Position -> Parser Position
forall a b. (a -> b) -> a -> b
$ Position -> Position
newPosition
    (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ (Element [(Square, (Piece, Color))] -> Position -> Position)
-> [(Square, (Piece, Color))] -> Position -> Position
forall {b} {c}.
MonoFoldable b =>
(Element b -> c -> c) -> b -> c -> c
foldrFlipped (Square, (Piece, Color)) -> Position -> Position
Element [(Square, (Piece, Color))] -> Position -> Position
includePiece [(Square, (Piece, Color))]
pieces
    (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ (Element [(CastlingRights, Color)] -> Position -> Position)
-> [(CastlingRights, Color)] -> Position -> Position
forall {b} {c}.
MonoFoldable b =>
(Element b -> c -> c) -> b -> c -> c
foldrFlipped (CastlingRights, Color) -> Position -> Position
Element [(CastlingRights, Color)] -> Position -> Position
includeCastling [(CastlingRights, Color)]
castling
    (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ (Element (Maybe Square) -> Position -> Position)
-> Maybe Square -> Position -> Position
forall {b} {c}.
MonoFoldable b =>
(Element b -> c -> c) -> b -> c -> c
foldrFlipped Square -> Position -> Position
Element (Maybe Square) -> Position -> Position
includeEnPassant Maybe Square
enPassant
    (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Ply -> Position -> Position
includeHalfMoveClock Ply
halfMoveClock
    (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Color -> Position -> Position
includeColor Color
color
    Position
emptyPosition
  where
  position :: Parser
  ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
   Maybe Square, Ply, Square)
position = (,,,,,)
    ([(Square, (Piece, Color))]
 -> Color
 -> [(CastlingRights, Color)]
 -> Maybe Square
 -> Ply
 -> Square
 -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
     Maybe Square, Ply, Square))
-> Parser [(Square, (Piece, Color))]
-> Parser
     (Color
      -> [(CastlingRights, Color)]
      -> Maybe Square
      -> Ply
      -> Square
      -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
          Maybe Square, Ply, Square))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [(Square, (Piece, Color))]
piecesP    Parser [(Square, (Piece, Color))]
-> Parser Char -> Parser [(Square, (Piece, Color))]
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space)
    Parser
  (Color
   -> [(CastlingRights, Color)]
   -> Maybe Square
   -> Ply
   -> Square
   -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
       Maybe Square, Ply, Square))
-> Parser Color
-> Parser
     ([(CastlingRights, Color)]
      -> Maybe Square
      -> Ply
      -> Square
      -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
          Maybe Square, Ply, Square))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Color
colorP     Parser Color -> Parser Char -> Parser Color
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space)
    Parser
  ([(CastlingRights, Color)]
   -> Maybe Square
   -> Ply
   -> Square
   -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
       Maybe Square, Ply, Square))
-> Parser [(CastlingRights, Color)]
-> Parser
     (Maybe Square
      -> Ply
      -> Square
      -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
          Maybe Square, Ply, Square))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser [(CastlingRights, Color)]
castlingP  Parser [(CastlingRights, Color)]
-> Parser Char -> Parser [(CastlingRights, Color)]
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space)
    Parser
  (Maybe Square
   -> Ply
   -> Square
   -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
       Maybe Square, Ply, Square))
-> Parser (Maybe Square)
-> Parser
     (Ply
      -> Square
      -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
          Maybe Square, Ply, Square))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (Maybe Square)
enPassantP Parser (Maybe Square) -> Parser Char -> Parser (Maybe Square)
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space)
    Parser
  (Ply
   -> Square
   -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
       Maybe Square, Ply, Square))
-> Parser Ply
-> Parser
     (Square
      -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
          Maybe Square, Ply, Square))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Ply
ply        Parser Ply -> Parser Char -> Parser Ply
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space)
    Parser
  (Square
   -> ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
       Maybe Square, Ply, Square))
-> Parser Square
-> Parser
     ([(Square, (Piece, Color))], Color, [(CastlingRights, Color)],
      Maybe Square, Ply, Square)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Square
unsignedInt
  piecesP :: Parser [(Square, (Piece, Color))]
piecesP =
    ([[Maybe (Piece, Color)]] -> [(Square, (Piece, Color))])
-> Parser [[Maybe (Piece, Color)]]
-> Parser [(Square, (Piece, Color))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (((Square, Maybe (Piece, Color)) -> Maybe (Square, (Piece, Color)))
-> [(Square, Maybe (Piece, Color))] -> [(Square, (Piece, Color))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Square
x, Maybe (Piece, Color)
y) -> (Square
x,) ((Piece, Color) -> (Square, (Piece, Color)))
-> Maybe (Piece, Color) -> Maybe (Square, (Piece, Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Piece, Color)
y) ([(Square, Maybe (Piece, Color))] -> [(Square, (Piece, Color))])
-> ([[Maybe (Piece, Color)]] -> [(Square, Maybe (Piece, Color))])
-> [[Maybe (Piece, Color)]]
-> [(Square, (Piece, Color))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Square]
-> [Maybe (Piece, Color)] -> [(Square, Maybe (Piece, Color))]
forall a b. [a] -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [Square
0 ..] ([Maybe (Piece, Color)] -> [(Square, Maybe (Piece, Color))])
-> ([[Maybe (Piece, Color)]] -> [Maybe (Piece, Color)])
-> [[Maybe (Piece, Color)]]
-> [(Square, Maybe (Piece, Color))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[Maybe (Piece, Color)]] -> [Maybe (Piece, Color)]
[[Maybe (Piece, Color)]] -> Element [[Maybe (Piece, Color)]]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
fold ([[Maybe (Piece, Color)]] -> [Maybe (Piece, Color)])
-> ([[Maybe (Piece, Color)]] -> [[Maybe (Piece, Color)]])
-> [[Maybe (Piece, Color)]]
-> [Maybe (Piece, Color)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[Maybe (Piece, Color)]] -> [[Maybe (Piece, Color)]]
forall seq. SemiSequence seq => seq -> seq
reverse)
    (Parser [[Maybe (Piece, Color)]]
 -> Parser [(Square, (Piece, Color))])
-> Parser [[Maybe (Piece, Color)]]
-> Parser [(Square, (Piece, Color))]
forall a b. (a -> b) -> a -> b
$ ([[Maybe (Piece, Color)]] -> Bool)
-> Parser [[Maybe (Piece, Color)]]
-> Parser [[Maybe (Piece, Color)]]
forall a. (a -> Bool) -> Parser a -> Parser a
satisfy [[Maybe (Piece, Color)]] -> Bool
forall {mono}. MonoFoldable mono => mono -> Bool
lengthCheck
    (Parser [[Maybe (Piece, Color)]]
 -> Parser [[Maybe (Piece, Color)]])
-> Parser [[Maybe (Piece, Color)]]
-> Parser [[Maybe (Piece, Color)]]
forall a b. (a -> b) -> a -> b
$ ([[Maybe (Piece, Color)]] -> Bool)
-> Parser [[Maybe (Piece, Color)]]
-> Parser [[Maybe (Piece, Color)]]
forall a. (a -> Bool) -> Parser a -> Parser a
satisfy ((Element [[Maybe (Piece, Color)]] -> Bool)
-> [[Maybe (Piece, Color)]] -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
all [Maybe (Piece, Color)] -> Bool
Element [[Maybe (Piece, Color)]] -> Bool
forall {mono}. MonoFoldable mono => mono -> Bool
lengthCheck)
    (Parser [[Maybe (Piece, Color)]]
 -> Parser [[Maybe (Piece, Color)]])
-> Parser [[Maybe (Piece, Color)]]
-> Parser [[Maybe (Piece, Color)]]
forall a b. (a -> b) -> a -> b
$ Parser Char
-> Parser [Maybe (Piece, Color)] -> Parser [[Maybe (Piece, Color)]]
forall a b. Parser a -> Parser b -> Parser [b]
manySepBy (Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'/') ([[Maybe (Piece, Color)]] -> [Maybe (Piece, Color)]
[[Maybe (Piece, Color)]] -> Element [[Maybe (Piece, Color)]]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
fold ([[Maybe (Piece, Color)]] -> [Maybe (Piece, Color)])
-> Parser [[Maybe (Piece, Color)]] -> Parser [Maybe (Piece, Color)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser [Maybe (Piece, Color)]
emptySquaresN Parser [Maybe (Piece, Color)]
-> Parser [Maybe (Piece, Color)] -> Parser [Maybe (Piece, Color)]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Maybe (Piece, Color)]
piece) |+))
  colorP :: Parser Color
colorP = Parser (Maybe Color) -> Parser Color
forall {b}. Parser (Maybe b) -> Parser b
mandatory ((Char -> Maybe Color) -> Parser Char -> Parser (Maybe Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Char -> Maybe Color
charToColor Parser Char
anyChar)
  castlingP :: Parser [(CastlingRights, Color)]
castlingP = (Parser (Maybe (CastlingRights, Color))
-> Parser (CastlingRights, Color)
forall {b}. Parser (Maybe b) -> Parser b
mandatory ((Char -> Maybe (CastlingRights, Color))
-> Parser Char -> Parser (Maybe (CastlingRights, Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Char -> Maybe (CastlingRights, Color)
charToCastlingRights Parser Char
anyChar) |+)
           Parser [(CastlingRights, Color)]
-> Parser [(CastlingRights, Color)]
-> Parser [(CastlingRights, Color)]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [] [(CastlingRights, Color)]
-> Parser Char -> Parser [(CastlingRights, Color)]
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'-'
  enPassantP :: Parser (Maybe Square)
enPassantP = Square -> Maybe Square
forall a. a -> Maybe a
Just (Square -> Maybe Square) -> Parser Square -> Parser (Maybe Square)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Square
squareParser
           Parser (Maybe Square)
-> Parser (Maybe Square) -> Parser (Maybe Square)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Square
forall a. Maybe a
Nothing Maybe Square -> Parser Char -> Parser (Maybe Square)
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'-'
  emptySquaresN :: Parser [Maybe (Piece, Color)]
emptySquaresN = (Index [Maybe (Piece, Color)]
-> Element [Maybe (Piece, Color)] -> [Maybe (Piece, Color)]
forall seq. IsSequence seq => Index seq -> Element seq -> seq
`replicate` Maybe (Piece, Color)
Element [Maybe (Piece, Color)]
forall a. Maybe a
Nothing) (Index [Maybe (Piece, Color)] -> [Maybe (Piece, Color)])
-> (Char -> Index [Maybe (Piece, Color)])
-> Char
-> [Maybe (Piece, Color)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Square
Char -> Index [Maybe (Piece, Color)]
digitToInt (Char -> [Maybe (Piece, Color)])
-> Parser Char -> Parser [Maybe (Piece, Color)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser Char
forall a. IsMatch a => [a] -> Parser a
oneOf [Char
'1' .. Char
'8']
  piece :: Parser [Maybe (Piece, Color)]
piece = Maybe (Piece, Color) -> [Maybe (Piece, Color)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Piece, Color) -> [Maybe (Piece, Color)])
-> ((Piece, Color) -> Maybe (Piece, Color))
-> (Piece, Color)
-> [Maybe (Piece, Color)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Piece, Color) -> Maybe (Piece, Color)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Piece, Color) -> [Maybe (Piece, Color)])
-> Parser (Piece, Color) -> Parser [Maybe (Piece, Color)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (Piece, Color)) -> Parser (Piece, Color)
forall {b}. Parser (Maybe b) -> Parser b
mandatory ((Char -> Maybe (Piece, Color))
-> Parser Char -> Parser (Maybe (Piece, Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Char -> Maybe (Piece, Color)
charToPiece Parser Char
anyChar)
  lengthCheck :: mono -> Bool
lengthCheck mono
xs = mono -> Square
forall mono. MonoFoldable mono => mono -> Square
length mono
xs Square -> Square -> Bool
forall a. Eq a => a -> a -> Bool
== Square
8
  ply :: Parser Ply
ply = Square -> Ply
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Square -> Ply) -> Parser Square -> Parser Ply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Square
unsignedInt
  mandatory :: Parser (Maybe b) -> Parser b
mandatory = (Maybe b -> Parser b) -> Parser (Maybe b) -> Parser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) (Parser b -> Maybe (Parser b) -> Parser b
forall a. a -> Maybe a -> a
fromMaybe Parser b
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty (Maybe (Parser b) -> Parser b)
-> (Maybe b -> Maybe (Parser b)) -> Maybe b -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> Parser b) -> Maybe b -> Maybe (Parser b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map b -> Parser b
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  foldrFlipped :: (Element b -> c -> c) -> b -> c -> c
foldrFlipped Element b -> c -> c
f = (c -> b -> c) -> b -> c -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((c -> b -> c) -> b -> c -> c) -> (c -> b -> c) -> b -> c -> c
forall a b. (a -> b) -> a -> b
$ (Element b -> c -> c) -> c -> b -> c
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr Element b -> c -> c
f


squareParser :: Parser Square
squareParser :: Parser Square
squareParser = Square -> Square -> Square
forall a. Num a => a -> a -> a
(+) (Square -> Square -> Square)
-> Parser Square -> Parser (Square -> Square)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Square
column Parser (Square -> Square) -> Parser Square -> Parser Square
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Square -> Square) -> Parser Square -> Parser Square
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Square -> Square -> Square
forall a. Num a => a -> a -> a
* Square
8) Parser Square
row
  where
    column :: Parser Square
column = (\Square
x -> Square
x Square -> Square -> Square
forall a. Num a => a -> a -> a
- Char -> Square
forall a. Enum a => a -> Square
fromEnum Char
'a') (Square -> Square) -> (Char -> Square) -> Char -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Square
forall a. Enum a => a -> Square
fromEnum (Char -> Square) -> Parser Char -> Parser Square
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser Char
forall a. IsMatch a => [a] -> Parser a
oneOf [Char
'a' .. Char
'h']
    row :: Parser Square
row = (\Square
x -> Square
x Square -> Square -> Square
forall a. Num a => a -> a -> a
- Square
1) (Square -> Square) -> (Char -> Square) -> Char -> Square
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Square
digitToInt (Char -> Square) -> Parser Char -> Parser Square
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser Char
forall a. IsMatch a => [a] -> Parser a
oneOf [Char
'1' .. Char
'8']


newPosition :: Position -> Position
newPosition :: Position -> Position
newPosition = Position -> Position
setInitialValues (Position -> Position)
-> (Position -> Position) -> Position -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Position -> Position
makeNullMove (Position -> Position)
-> (Position -> Position) -> Position -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Position -> Position
makeNullMove
  where
  setInitialValues :: Position -> Position
setInitialValues Position
pos = Position
pos {
    phase = getPhase pos
  }


includePiece :: (Square, (Piece, Color)) -> Position -> Position
includePiece :: (Square, (Piece, Color)) -> Position -> Position
includePiece (Square
square, (Piece
piece, Color
pieceColor)) pos :: Position
pos@Position {Phase
[ZKey]
Ply
Board
Color
$sel:phase:Position :: Position -> Phase
previousPositions :: [ZKey]
halfMoveClock :: Ply
phase :: Phase
color :: Color
player :: Board
enemy :: Board
pawns :: Board
knights :: Board
bishops :: Board
rooks :: Board
queens :: Board
kings :: Board
enPassant :: Board
castling :: Board
attacked :: Board
leapingCheckers :: Board
sliderCheckers :: Board
pinnedPieces :: Board
$sel:previousPositions:Position :: Position -> [ZKey]
$sel:halfMoveClock:Position :: Position -> Ply
$sel:color:Position :: Position -> Color
$sel:player:Position :: Position -> Board
$sel:enemy:Position :: Position -> Board
$sel:pawns:Position :: Position -> Board
$sel:knights:Position :: Position -> Board
$sel:bishops:Position :: Position -> Board
$sel:rooks:Position :: Position -> Board
$sel:queens:Position :: Position -> Board
$sel:kings:Position :: Position -> Board
$sel:enPassant:Position :: Position -> Board
$sel:castling:Position :: Position -> Board
$sel:attacked:Position :: Position -> Board
$sel:leapingCheckers:Position :: Position -> Board
$sel:sliderCheckers:Position :: Position -> Board
$sel:pinnedPieces:Position :: Position -> Board
..} =
  if Color
pieceColor Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
color then
    Position
pos' { player = player .| board }
  else
    Position
pos' { enemy  = enemy  .| board }
  where
  pos' :: Position
pos' = case Piece
piece of
    Piece
Pawn   -> Position
pos { pawns   = pawns   .| board }
    Piece
Knight -> Position
pos { knights = knights .| board }
    Piece
Bishop -> Position
pos { bishops = bishops .| board }
    Piece
Rook   -> Position
pos { rooks   = rooks   .| board }
    Piece
Queen  -> Position
pos { queens  = queens  .| board }
    Piece
King   -> Position
pos { kings   = kings   .| board }
  board :: Board
board = Square -> Board
toBoard Square
square


includeHalfMoveClock :: Ply -> Position -> Position
includeHalfMoveClock :: Ply -> Position -> Position
includeHalfMoveClock Ply
halfMoveClock Position
pos =
  Position
pos { halfMoveClock = halfMoveClock }


includeColor :: Color -> Position -> Position
includeColor :: Color -> Position -> Position
includeColor Color
color Position
pos =
  Position
pos { color = color }


includeCastling :: (CastlingRights, Color) -> Position -> Position
includeCastling :: (CastlingRights, Color) -> Position -> Position
includeCastling (CastlingRights
castlingRights, Color
castlingColor) pos :: Position
pos@Position {Phase
[ZKey]
Ply
Board
Color
$sel:phase:Position :: Position -> Phase
$sel:previousPositions:Position :: Position -> [ZKey]
$sel:halfMoveClock:Position :: Position -> Ply
$sel:color:Position :: Position -> Color
$sel:player:Position :: Position -> Board
$sel:enemy:Position :: Position -> Board
$sel:pawns:Position :: Position -> Board
$sel:knights:Position :: Position -> Board
$sel:bishops:Position :: Position -> Board
$sel:rooks:Position :: Position -> Board
$sel:queens:Position :: Position -> Board
$sel:kings:Position :: Position -> Board
$sel:enPassant:Position :: Position -> Board
$sel:castling:Position :: Position -> Board
$sel:attacked:Position :: Position -> Board
$sel:leapingCheckers:Position :: Position -> Board
$sel:sliderCheckers:Position :: Position -> Board
$sel:pinnedPieces:Position :: Position -> Board
previousPositions :: [ZKey]
halfMoveClock :: Ply
phase :: Phase
color :: Color
player :: Board
enemy :: Board
pawns :: Board
knights :: Board
bishops :: Board
rooks :: Board
queens :: Board
kings :: Board
enPassant :: Board
castling :: Board
attacked :: Board
leapingCheckers :: Board
sliderCheckers :: Board
pinnedPieces :: Board
..} =
  Position
pos { castling = castling .| row & (column .| file_E) }
  where
  row :: Board
row = case Color
castlingColor of
    Color
White -> Board
rank_1
    Color
Black -> Board
rank_8
  column :: Board
column = case CastlingRights
castlingRights of
    CastlingRights
QueenSide -> Board
file_A
    CastlingRights
KingSide  -> Board
file_H


includeEnPassant :: Square -> Position -> Position
includeEnPassant :: Square -> Position -> Position
includeEnPassant Square
square Position
pos =
  Position
pos { enPassant = toBoard square }