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 }