{-# LANGUAGE CPP #-}
module BishBosh.ContextualNotation.StandardAlgebraic(
ValidateMoves,
ExplicitEnPassant,
StandardAlgebraic(
getQualifiedMove
),
showsCoordinates,
showsTurn,
showTurn,
showsMove,
showMove,
movePiece,
parser,
fromRank,
toRank,
fromQualifiedMove
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Abscissa as Cartesian.Abscissa
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Ordinate as Cartesian.Ordinate
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Component.Piece as Component.Piece
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Component.Turn as Component.Turn
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Model.Game as Model.Game
import qualified BishBosh.Model.GameTerminationReason as Model.GameTerminationReason
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.State.Board as State.Board
import qualified BishBosh.State.MaybePieceByCoordinates as State.MaybePieceByCoordinates
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Types as T
import qualified Control.Applicative
import qualified Control.Exception
import qualified Control.Monad
import qualified Data.Char
import qualified Data.List
import qualified Data.Maybe
#ifdef USE_POLYPARSE
import qualified BishBosh.Text.Poly as Text.Poly
#if USE_POLYPARSE == 1
import qualified Text.ParserCombinators.Poly.Lazy as Poly
#else /* Plain */
import qualified Text.ParserCombinators.Poly.Plain as Poly
#endif
#else /* Parsec */
import qualified Text.ParserCombinators.Parsec as Parsec
import Text.ParserCombinators.Parsec((<?>), (<|>))
#endif
type ValidateMoves = Bool
captureFlag :: Char
captureFlag = 'x'
checkFlag :: Char
checkFlag = '+'
checkMateFlag :: Char
checkMateFlag = '#'
promotionFlag :: Char
promotionFlag = '='
enPassantToken :: String
enPassantToken = "e.p."
longCastleToken :: String
longCastleToken = "O-O-O"
shortCastleToken :: String
shortCastleToken = "O-O"
moveSuffixAnnotations :: String
moveSuffixAnnotations = "!?"
min' :: (Char, Char)
xMin, yMin :: Char
min'@(xMin, yMin) = ('a', '1')
origin :: (Int, Int)
xOrigin, yOrigin :: Int
origin@(xOrigin, yOrigin) = Data.Char.ord *** Data.Char.ord $ min'
xMax, yMax :: Char
(xMax, yMax) = Data.Char.chr . (
+ pred (fromIntegral Cartesian.Abscissa.xLength)
) *** Data.Char.chr . (
+ pred (fromIntegral Cartesian.Ordinate.yLength)
) $ origin
inXRange :: Char -> Bool
inXRange = uncurry (&&) . ((>= xMin) &&& (<= xMax))
inYRange :: Char -> Bool
inYRange = uncurry (&&) . ((>= yMin) &&& (<= yMax))
newtype StandardAlgebraic x y = MkStandardAlgebraic {
getQualifiedMove :: Component.QualifiedMove.QualifiedMove x y
} deriving (Eq, Show)
fromQualifiedMove :: Component.QualifiedMove.QualifiedMove x y -> StandardAlgebraic x y
fromQualifiedMove = MkStandardAlgebraic
encode :: (Enum x, Enum y) => Cartesian.Coordinates.Coordinates x y -> (ShowS, ShowS)
encode = showChar . Data.Char.chr . (+ (xOrigin - Cartesian.Abscissa.xOrigin)) . fromEnum . Cartesian.Coordinates.getX &&& showChar . Data.Char.chr . (+ (yOrigin - Cartesian.Ordinate.yOrigin)) . fromEnum . Cartesian.Coordinates.getY
showsCoordinates :: (Enum x, Enum y) => Cartesian.Coordinates.Coordinates x y -> ShowS
showsCoordinates = uncurry (.) . encode
type ExplicitEnPassant = Bool
showsTurn :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> ExplicitEnPassant
-> Component.Turn.Turn x y
-> Model.Game.Game x y
-> ShowS
{-# SPECIALISE showsTurn :: ExplicitEnPassant -> Component.Turn.Turn T.X T.Y -> Model.Game.Game T.X T.Y -> ShowS #-}
showsTurn explicitEnPassant turn game
| Just sourceRank <- fmap Component.Piece.getRank . State.MaybePieceByCoordinates.dereference source $ State.Board.getMaybePieceByCoordinates board = (
if sourceRank == Attribute.Rank.Pawn
then (
if isCapture
then showsX . showsCapture
else id
) . showsDestination . if isEnPassant
then if explicitEnPassant
then showString enPassantToken
else id
else Data.Maybe.maybe id (
\promotionRank -> showChar promotionFlag . showsRank promotionRank
) $ Attribute.Rank.getMaybePromotionRank moveType
else case moveType of
Attribute.MoveType.Castle isShort -> showString $ if isShort
then shortCastleToken
else longCastleToken
_ -> showsRank sourceRank . (
case Data.List.delete source $ State.Board.findAttacksBy (
Component.Piece.mkPiece (Model.Game.getNextLogicalColour game) sourceRank
) destination board of
[] -> id
coordinates -> case any (
(== Cartesian.Coordinates.getX source) . Cartesian.Coordinates.getX
) &&& any (
(== Cartesian.Coordinates.getY source) . Cartesian.Coordinates.getY
) $ coordinates of
(True, True) -> showsX . showsY
(_, False) -> showsY
_ -> showsX
) . (
if isCapture
then showsCapture
else id
) . showsDestination
) . (
if Data.Maybe.isJust $ Model.Game.getMaybeChecked game'
then showChar $ if Data.Maybe.maybe False Model.GameTerminationReason.isCheckMate $ Model.Game.getMaybeTerminationReason game'
then checkMateFlag
else checkFlag
else id
)
| otherwise = Control.Exception.throw . Data.Exception.mkSearchFailure . showString "BishBosh.ContextualNotation.StandardAlgebraic.showsTurn:\tno piece exists at " . showsCoordinates source . showString "; " $ Property.ForsythEdwards.showsFEN game "."
where
((source, destination), moveType) = (Component.Move.getSource &&& Component.Move.getDestination) . Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType $ Component.Turn.getQualifiedMove turn
board = Model.Game.getBoard game
isEnPassant, isCapture :: Bool
isEnPassant = Attribute.MoveType.isEnPassant moveType
isCapture = State.MaybePieceByCoordinates.isOccupied destination (State.Board.getMaybePieceByCoordinates board) || isEnPassant
showsRank :: Attribute.Rank.Rank -> ShowS
showsRank rank = showChar $ fromRank rank
showsCapture, showsX, showsY, showsDestination :: ShowS
showsCapture = showChar captureFlag
(showsX, showsY) = encode source
showsDestination = showsCoordinates destination
game' = Model.Game.takeTurn turn game
showTurn :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> ExplicitEnPassant
-> Component.Turn.Turn x y
-> Model.Game.Game x y
-> String
{-# SPECIALISE showTurn :: ExplicitEnPassant -> Component.Turn.Turn T.X T.Y -> Model.Game.Game T.X T.Y -> String #-}
showTurn explicitEnPassant turn game = showsTurn explicitEnPassant turn game ""
showsMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> ExplicitEnPassant
-> Component.QualifiedMove.QualifiedMove x y
-> Model.Game.Game x y
-> ShowS
{-# SPECIALISE showsMove :: ExplicitEnPassant -> Component.QualifiedMove.QualifiedMove T.X T.Y -> Model.Game.Game T.X T.Y -> ShowS #-}
showsMove explicitEnPassant qualifiedMove game = showsTurn explicitEnPassant (
Data.Maybe.fromMaybe (
Control.Exception.throw $ Data.Exception.mkResultUndefined "BishBosh.ContextualNotation.StandardAlgebraic.showsMove:\tModel.Game.maybeLastTurn failed."
) . Model.Game.maybeLastTurn $ Model.Game.applyQualifiedMove qualifiedMove game
) game
showMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> ExplicitEnPassant
-> Component.QualifiedMove.QualifiedMove x y
-> Model.Game.Game x y
-> String
{-# SPECIALISE showMove :: ExplicitEnPassant -> Component.QualifiedMove.QualifiedMove T.X T.Y -> Model.Game.Game T.X T.Y -> String #-}
showMove explicitEnPassant qualifiedMove game = showsMove explicitEnPassant qualifiedMove game ""
movePiece :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => StandardAlgebraic x y -> Model.Game.Transformation x y
{-# SPECIALISE movePiece :: StandardAlgebraic T.X T.Y -> Model.Game.Transformation T.X T.Y #-}
movePiece MkStandardAlgebraic { getQualifiedMove = qualifiedMove } = Model.Game.applyQualifiedMove qualifiedMove
#ifdef USE_POLYPARSE
rankParser :: Text.Poly.TextParser Attribute.Rank.Rank
rankParser = toRank `fmap` Poly.satisfyMsg (`elem` map fromRank Attribute.Rank.pieces) Attribute.Rank.tag
abscissaParser :: Enum x => Text.Poly.TextParser x
{-# SPECIALISE abscissaParser :: Text.Poly.TextParser T.X #-}
abscissaParser = (
toEnum . (+ (Cartesian.Abscissa.xOrigin - xOrigin)) . Data.Char.ord
) `fmap` Poly.satisfyMsg inXRange "Abscissa"
ordinateParser :: Enum y => Text.Poly.TextParser y
{-# SPECIALISE ordinateParser :: Text.Poly.TextParser T.Y #-}
ordinateParser = (
toEnum . (+ (Cartesian.Ordinate.yOrigin - yOrigin)) . Data.Char.ord
) `fmap` Poly.satisfyMsg inYRange "Ordinate"
coordinatesParser :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Text.Poly.TextParser (Cartesian.Coordinates.Coordinates x y)
{-# SPECIALISE coordinatesParser :: Text.Poly.TextParser (Cartesian.Coordinates.Coordinates T.X T.Y) #-}
coordinatesParser = do
x <- abscissaParser
y <- ordinateParser
return $ Cartesian.Coordinates.mkCoordinates x y
captureParser :: Text.Poly.TextParser Char
captureParser = Poly.satisfyMsg (== captureFlag) "Capture"
#else
rankParser :: Parsec.Parser Attribute.Rank.Rank
rankParser = toRank <$> Parsec.oneOf (map fromRank Attribute.Rank.pieces) <?> Attribute.Rank.tag
abscissaParser :: Enum x => Parsec.Parser x
{-# SPECIALISE abscissaParser :: Parsec.Parser T.X #-}
abscissaParser = (
toEnum . (+ (Cartesian.Abscissa.xOrigin - xOrigin)) . Data.Char.ord
) <$> Parsec.satisfy inXRange <?> "Abscissa"
ordinateParser :: Enum y => Parsec.Parser y
{-# SPECIALISE ordinateParser :: Parsec.Parser T.X #-}
ordinateParser = (
toEnum . (+ (Cartesian.Ordinate.yOrigin - yOrigin)) . Data.Char.ord
) <$> Parsec.satisfy inYRange <?> "Ordinate"
coordinatesParser :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Parsec.Parser (Cartesian.Coordinates.Coordinates x y)
{-# SPECIALISE coordinatesParser :: Parsec.Parser (Cartesian.Coordinates.Coordinates T.X T.Y) #-}
coordinatesParser = Cartesian.Coordinates.mkCoordinates <$> abscissaParser <*> ordinateParser
captureParser :: Parsec.Parser ()
captureParser = Control.Monad.void (Parsec.char captureFlag <?> "Capture")
#endif
moveSuffixAnnotationParser ::
#ifdef USE_POLYPARSE
Text.Poly.TextParser String
moveSuffixAnnotationParser = Text.Poly.spaces >> Control.Applicative.some (Poly.oneOf' $ map (\c -> ([c], Poly.satisfyMsg (== c) "Move Suffix-annotation")) moveSuffixAnnotations)
#else /* Parsec */
Parsec.Parser String
moveSuffixAnnotationParser = Parsec.try (
Parsec.spaces >> Control.Applicative.some (Parsec.choice $ map Parsec.char moveSuffixAnnotations) <?> "Move Suffix-annotation"
)
#endif
parser :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> ExplicitEnPassant
-> ValidateMoves
-> Model.Game.Game x y
#ifdef USE_POLYPARSE
-> Text.Poly.TextParser (StandardAlgebraic x y)
{-# SPECIALISE parser :: ExplicitEnPassant -> ValidateMoves -> Model.Game.Game T.X T.Y -> Text.Poly.TextParser (StandardAlgebraic T.X T.Y) #-}
parser explicitEnPassant validateMoves game = let
nextLogicalColour = Model.Game.getNextLogicalColour game
(shortCastlingMoves, longCastlingMoves) = Data.List.partition (\(Attribute.MoveType.Castle isShort, _, _) -> isShort) $ Component.Move.castlingMovesByLogicalColour ! nextLogicalColour
board = Model.Game.getBoard game
getMaybePiece = (`State.MaybePieceByCoordinates.dereference` State.Board.getMaybePieceByCoordinates board)
getMaybeRank = fmap Component.Piece.getRank . getMaybePiece
in do
qualifiedMove <- Text.Poly.spaces >> Poly.oneOf' [
(
"Non-castling move",
do
rank <- Data.Maybe.fromMaybe Attribute.Rank.Pawn `fmap` Control.Applicative.optional rankParser
let
piece :: Component.Piece.Piece
piece = Component.Piece.mkPiece nextLogicalColour rank
findAttacksBy destination = State.Board.findAttacksBy piece destination board
if rank == Attribute.Rank.Pawn
then let
promotionParser :: Text.Poly.TextParser Attribute.Rank.Rank
promotionParser = Text.Poly.char promotionFlag >> rankParser
in Poly.oneOf' [
(
"Pawn-advance",
do
destination <- coordinatesParser
Data.Maybe.maybe (
do
context <- Poly.manyFinally' Poly.next $ Text.Poly.char '\n'
Poly.failBad . showString "failed to locate any " . shows piece . showString " which can advance to " . shows destination . showString ". Before " $ shows context "."
) (
\source -> (
Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) . Attribute.MoveType.mkNormalMoveType Nothing
) `fmap` Control.Applicative.optional promotionParser
) . Data.List.find (
(== Just piece) . getMaybePiece
) . Data.Maybe.catMaybes . take 2 . tail $ iterate (
>>= Cartesian.Coordinates.maybeRetreat nextLogicalColour
) $ Just destination
), (
"Pawn-capture",
do
x <- abscissaParser
_ <- captureParser
destination <- Poly.commit coordinatesParser
let maybeDestinationRank = getMaybeRank destination
Data.Maybe.maybe (
do
context <- Poly.manyFinally' Poly.next $ Text.Poly.char '\n'
Poly.failBad . showString "failed to locate any " . shows piece . showString " which can capture " . shows destination . showString " from abscissa" . Text.ShowList.showsAssociation . shows x . showString ". Before " $ shows context "."
) (
\source -> Component.QualifiedMove.mkQualifiedMove (
Component.Move.mkMove source destination
) `fmap` Poly.oneOf' [
(
"En-passant",
do
if explicitEnPassant
then Text.Poly.string enPassantToken
else Control.Monad.when (Data.Maybe.isJust maybeDestinationRank) $ fail undefined
return Attribute.MoveType.enPassant
), (
"Normal pawn capture",
Poly.commit $ Attribute.MoveType.mkNormalMoveType maybeDestinationRank `fmap` Control.Applicative.optional promotionParser
)
]
) . Data.List.find (
(== x) . Cartesian.Coordinates.getX
) $ findAttacksBy destination
)
]
else let
mkNormalMoveType destination = Attribute.MoveType.mkNormalMoveType (getMaybeRank destination) Nothing
resolveQualifiedMove destination candidates = case candidates of
[] -> do
context <- Poly.manyFinally' Poly.next $ Text.Poly.char '\n'
Poly.failBad . showString "failed to locate any " . shows piece . showString " able to move to " . shows destination . showString ". Before " $ shows context "."
[source] -> return . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination
sourceCandidates -> Poly.oneOf' [
show &&& return $ qualifiedMove |
source <- sourceCandidates,
let qualifiedMove = Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,
Model.Game.isValidQualifiedMove qualifiedMove game
]
in Poly.oneOf' [
(
"Fully qualified move",
do
source <- coordinatesParser
destination <- Control.Applicative.optional captureParser >> coordinatesParser
return . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination
), (
"Partially qualified move",
do
sourceFilter <- Poly.oneOf' [
(
"Abscissa qualification",
(
\x -> filter $ (== x) . Cartesian.Coordinates.getX
) `fmap` abscissaParser
), (
"Ordinate qualification",
(
\y -> filter $ (== y) . Cartesian.Coordinates.getY
) `fmap` ordinateParser
)
]
destination <- Control.Applicative.optional captureParser >> coordinatesParser
resolveQualifiedMove destination . sourceFilter $ findAttacksBy destination
), (
"Unqualified move",
Poly.commit $ do
destination <- Control.Applicative.optional captureParser >> coordinatesParser
resolveQualifiedMove destination $ findAttacksBy destination
)
]
), (
"Long castle",
Text.Poly.string longCastleToken >> Data.Maybe.maybe (
fail "Failed to find any appropriate long castling move."
) (
\(moveType, kingsMove, _) -> return $ Component.QualifiedMove.mkQualifiedMove kingsMove moveType
) (
Data.Maybe.listToMaybe longCastlingMoves
)
), (
"Short castle",
Text.Poly.string shortCastleToken >> Data.Maybe.maybe (
fail "Failed to find any appropriate short castling move."
) (
\(moveType, kingsMove, _) -> return $ Component.QualifiedMove.mkQualifiedMove kingsMove moveType
) (
Data.Maybe.listToMaybe shortCastlingMoves
)
)
]
_ <- Control.Applicative.optional (Poly.satisfyMsg (`elem` [checkFlag, checkMateFlag]) "Check") >> Control.Applicative.optional moveSuffixAnnotationParser
fmap fromQualifiedMove $ if validateMoves
then Data.Maybe.maybe (return qualifiedMove) (Poly.failBad . showString "failed: ") $ Model.Game.validateQualifiedMove qualifiedMove game
else return qualifiedMove
#else /* Parsec */
-> Parsec.Parser (StandardAlgebraic x y)
{-# SPECIALISE parser :: ExplicitEnPassant -> ValidateMoves -> Model.Game.Game T.X T.Y -> Parsec.Parser (StandardAlgebraic T.X T.Y) #-}
parser explicitEnPassant validateMoves game = let
nextLogicalColour = Model.Game.getNextLogicalColour game
(shortCastlingMoves, longCastlingMoves) = Data.List.partition (\(Attribute.MoveType.Castle isShort, _, _) -> isShort) $ Component.Move.castlingMovesByLogicalColour ! nextLogicalColour
board = Model.Game.getBoard game
getMaybePiece = (`State.MaybePieceByCoordinates.dereference` State.Board.getMaybePieceByCoordinates board)
getMaybeRank = fmap Component.Piece.getRank . getMaybePiece
in do
qualifiedMove <- Parsec.spaces >> Parsec.choice [
do
rank <- Parsec.option Attribute.Rank.Pawn rankParser
let
piece :: Component.Piece.Piece
piece = Component.Piece.mkPiece nextLogicalColour rank
findAttacksBy destination = State.Board.findAttacksBy piece destination board
if rank == Attribute.Rank.Pawn
then let
promotionParser :: Parsec.Parser Attribute.Rank.Rank
promotionParser = (Parsec.char promotionFlag <?> "Promotion") >> rankParser
in Parsec.try (
do
destination <- coordinatesParser <?> "Destination"
Data.Maybe.maybe (
fail . showString "Failed to locate any " . shows piece . showString " which can advance to " $ shows destination "."
) (
\source -> (
Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) . Attribute.MoveType.mkNormalMoveType Nothing
) <$> Control.Applicative.optional promotionParser
) . Data.List.find (
Data.Maybe.maybe False (== piece) . getMaybePiece
) . Data.Maybe.catMaybes . take 2 . tail $ iterate (
>>= Cartesian.Coordinates.maybeRetreat nextLogicalColour
) $ Just destination
) <|> do
x <- abscissaParser <* captureParser
destination <- coordinatesParser <?> "Destination"
let maybeDestinationRank = getMaybeRank destination
Data.Maybe.maybe (
fail . showString "Failed to locate any " . shows piece . showString " which can capture " . shows destination . showString " from abscissa" . Text.ShowList.showsAssociation $ shows x "."
) (
\source -> fmap (
Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination)
) $ (
do
_ <- if explicitEnPassant
then Parsec.string enPassantToken <?> "En-passant"
else if Data.Maybe.isNothing maybeDestinationRank
then return enPassantToken
else fail undefined
return Attribute.MoveType.enPassant
) <|> (
Attribute.MoveType.mkNormalMoveType maybeDestinationRank <$> Control.Applicative.optional promotionParser
)
) . Data.List.find (
(== x) . Cartesian.Coordinates.getX
) $ findAttacksBy destination
else let
mkNormalMoveType destination = Attribute.MoveType.mkNormalMoveType (getMaybeRank destination) Nothing
resolveQualifiedMove destination candidates = case candidates of
[] -> fail . showString "Failed to locate any " . shows piece . showString " able to move to " $ shows destination "."
[source] -> return . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination
sourceCandidates -> Parsec.choice [
Parsec.try $ return qualifiedMove |
source <- sourceCandidates,
let qualifiedMove = Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,
Model.Game.isValidQualifiedMove qualifiedMove game
]
in Parsec.choice [
Parsec.try $ do
source <- coordinatesParser <?> "Source"
Parsec.optional captureParser <?> "Optional capture"
destination <- coordinatesParser <?> "Destination"
return . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,
Parsec.try $ do
sourceFilter <- (
(
\x -> filter $ (== x) . Cartesian.Coordinates.getX
) <$> abscissaParser
) <|> (
(
\y -> filter $ (== y) . Cartesian.Coordinates.getY
) <$> ordinateParser
)
Parsec.optional captureParser <?> "Optional capture"
destination <- coordinatesParser <?> "Destination"
resolveQualifiedMove destination . sourceFilter $ findAttacksBy destination,
do
Parsec.optional captureParser <?> "Optional capture"
destination <- coordinatesParser <?> "Unqualified destination"
resolveQualifiedMove destination $ findAttacksBy destination
],
Parsec.try $ (
Parsec.string longCastleToken <?> "Long castle"
) >> Data.Maybe.maybe (
fail "Failed to find any appropriate long castling move."
) (
\(moveType, kingsMove, _) -> return $ Component.QualifiedMove.mkQualifiedMove kingsMove moveType
) (
Data.Maybe.listToMaybe longCastlingMoves
),
(
Parsec.string shortCastleToken <?> "Short castle"
) >> Data.Maybe.maybe (
fail "Failed to find any appropriate short castling move."
) (
\(moveType, kingsMove, _) -> return $ Component.QualifiedMove.mkQualifiedMove kingsMove moveType
) (
Data.Maybe.listToMaybe shortCastlingMoves
)
]
_ <- Parsec.optional (Parsec.oneOf [checkFlag, checkMateFlag] <?> "Check") >> Parsec.optional moveSuffixAnnotationParser
fromQualifiedMove <$> if validateMoves
then Data.Maybe.maybe (return qualifiedMove) (fail . showString "Failed: ") $ Model.Game.validateQualifiedMove qualifiedMove game
else return qualifiedMove
#endif
fromRank :: Attribute.Rank.Rank -> Char
fromRank = Data.Char.toUpper . head . show
toRank :: Char -> Attribute.Rank.Rank
toRank = read . return