{-# LANGUAGE CPP #-}
{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	<https://en.wikipedia.org/wiki/Algebraic_notation_(chess)>
-}

module BishBosh.ContextualNotation.StandardAlgebraic(
-- * Types
-- ** Type-synonyms
        ValidateMoves,
        ExplicitEnPassant,
-- ** Data-types
        StandardAlgebraic(
--		MkStandardAlgebraic
                getQualifiedMove
        ),
-- * Constants
--	captureFlag,
--	checkFlag,
--	checkMateFlag,
--	promotionFlag,
--	enPassantToken,
--	longCastleToken,
--	shortCastleToken,
--	moveSuffixAnnotations,
--	xMin,
--	yMin,
--	xMax,
--	yMax,
--	xOrigin,
--	yOrigin,
-- * Functions
--	encode,
        showsCoordinates,
        showsTurn,
        showTurn,
        showsMove,
        showMove,
        movePiece,
--	rankParser,
--	abscissaParser,
--	ordinateParser,
--	coordinatesParser,
--	captureParser,
--	moveSuffixAnnotationParser,
        parser,
        fromRank,
        toRank,
-- ** Constructors
        fromQualifiedMove
-- ** Predicates
--	inXRange,
--	inYRange
) 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

-- | Whether each move should be validated.
type ValidateMoves      = Bool

-- | Constant indication of capture.
captureFlag :: Char
captureFlag             = 'x'

-- | Constant indication of Check.
checkFlag :: Char
checkFlag               = '+'

-- | Constant indication of Check-mate.
checkMateFlag :: Char
checkMateFlag           = '#'

-- | Constant indication of promotion.
promotionFlag :: Char
promotionFlag           = '='

-- | Constant indication of En-passant.
enPassantToken :: String
enPassantToken          = "e.p."

-- | Constant indication of a long @Queen@-side Castle.
longCastleToken :: String
longCastleToken         = "O-O-O"

-- | Constant indication of a short @King@-side Castle.
shortCastleToken :: String
shortCastleToken        = "O-O"

{- |
	* The characters which may be used to annotate a half move.

	* Zero to two of these (including duplicates) may follow each half move, but the parser intentionally permits any number.

	* CAVEAT: the parser intentionally permits any number of annotations.
-}
moveSuffixAnnotations :: String
moveSuffixAnnotations   = "!?"

-- | The minimum permissible values for /x/ & /y/ coordinates.
min' :: (Char, Char)
xMin, yMin :: Char
min'@(xMin, yMin)       = ('a', '1')

-- | The origin of the coordinate-system.
origin :: (Int, Int)
xOrigin, yOrigin :: Int
origin@(xOrigin, yOrigin)       = Data.Char.ord *** Data.Char.ord $ min'

-- | The maximum permissible values for /x/ & /y/ coordinates.
xMax, yMax :: Char
(xMax, yMax)    = Data.Char.chr . (
        + pred {-fence-post-} (fromIntegral Cartesian.Abscissa.xLength)
 ) *** Data.Char.chr . (
        + pred {-fence-post-} (fromIntegral Cartesian.Ordinate.yLength)
 ) $ origin

-- | Whether the specified character is a valid abscissa.
inXRange :: Char -> Bool
inXRange        = uncurry (&&) . ((>= xMin) &&& (<= xMax))

-- | Whether the specified character is a valid ordinate.
inYRange :: Char -> Bool
inYRange        = uncurry (&&) . ((>= yMin) &&& (<= yMax))

-- | Defines a /move/, to enable i/o in /StandardAlgebraic/-notation.
newtype StandardAlgebraic x y   = MkStandardAlgebraic {
        getQualifiedMove        :: Component.QualifiedMove.QualifiedMove x y
} deriving (Eq, Show)

-- | Constructor.
fromQualifiedMove :: Component.QualifiedMove.QualifiedMove x y -> StandardAlgebraic x y
fromQualifiedMove       = MkStandardAlgebraic

-- | Encodes the ordinate & abscissa.
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

-- | Shows the specified /coordinates/.
showsCoordinates :: (Enum x, Enum y) => Cartesian.Coordinates.Coordinates x y -> ShowS
showsCoordinates        = uncurry (.) . encode

-- | Whether en-passant moves are tagged, or implicit.
type ExplicitEnPassant  = Bool

-- | Represent the specified /turn/ in SAN.
showsTurn :: (
        Enum    x,
        Enum    y,
        Ord     x,
        Ord     y,
        Show    x,
        Show    y
 )
        => ExplicitEnPassant
        -> Component.Turn.Turn x y
        -> Model.Game.Game x y  -- ^ The /game/ prior to application of the specified /turn/.
        -> 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 {-not a Pawn-} case moveType of
                                Attribute.MoveType.Castle isShort       -> showString $ if isShort
                                        then shortCastleToken
                                        else longCastleToken
                                _ {-not a castling-}                    -> showsRank sourceRank . (
                                        case Data.List.delete source {-search for alternatives-} $ State.Board.findAttacksBy (
                                                Component.Piece.mkPiece (Model.Game.getNextLogicalColour game) sourceRank
                                        ) destination board of
                                                []              -> id   -- There're aren't any pieces of this rank which can perform this move.
                                                coordinates     -> case any (
                                                        (== Cartesian.Coordinates.getX source) . Cartesian.Coordinates.getX
                                                 ) &&& any (
                                                        (== Cartesian.Coordinates.getY source) . Cartesian.Coordinates.getY
                                                 ) $ coordinates of
                                                        (True, True)    -> showsX . showsY      -- There're other pieces of this rank, some with similar X-coordinate & some with similar Y-coordinate.
                                                        (_, False)      -> showsY               -- There's another piece of this rank & X-coordinate; specify Y-coordinate to disambiguate.
                                                        _               -> showsX               -- There's anoher piece of this rank, but neither X nor Y coordinates are similar.
                                 ) . (
                                        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

-- | Calls 'showsTurn'.
showTurn :: (
        Enum    x,
        Enum    y,
        Ord     x,
        Ord     y,
        Show    x,
        Show    y
 )
        => ExplicitEnPassant
        -> Component.Turn.Turn x y
        -> Model.Game.Game x y  -- ^ The /game/ prior to application of the specified /turn/.
        -> 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 ""

-- | A convenience-function, which generates the /turn/ required to call 'showsTurn'.
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

-- | Calls 'showsMove'.
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 ""

-- | Applies the specified /move/ to the specified /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
-- | Parse the /rank/ of the /piece/ being moved.
rankParser :: Text.Poly.TextParser Attribute.Rank.Rank
rankParser      = toRank `fmap` Poly.satisfyMsg (`elem` map fromRank Attribute.Rank.pieces) Attribute.Rank.tag

-- | Parse an /x/-coordinate.
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"

-- | Parse a /y/-coordinate.
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"

-- | Parse a pair of /coordinates/.
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 {-to Parser-monad-} $ Cartesian.Coordinates.mkCoordinates x y

-- | Parse the flag which denotes capture.
captureParser :: Text.Poly.TextParser Char
captureParser   = Poly.satisfyMsg (== captureFlag) "Capture"
#else
-- | Parse the /rank/ of the /piece/ being moved.
rankParser :: Parsec.Parser Attribute.Rank.Rank
rankParser      = toRank <$> Parsec.oneOf (map fromRank Attribute.Rank.pieces) <?> Attribute.Rank.tag

-- | Parse an /x/-coordinate.
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"

-- | Parse a /y/-coordinate.
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"

-- | Parse a pair of /coordinates/.
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

-- | Parse the flag which denotes capture.
captureParser :: Parsec.Parser ()
captureParser   = Control.Monad.void (Parsec.char captureFlag <?> "Capture")
#endif

-- | Parse a Move Suffix-annotation.
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

-- | Parses a /move/ from SAN, & optionally validates it against the specified /game/.
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 {-capture-}
                                                                        ) `fmap` Control.Applicative.optional promotionParser
                                                                 ) . Data.List.find (
                                                                        (== Just piece) . getMaybePiece
                                                                 ) . Data.Maybe.catMaybes . take 2 {-maximum Pawn-advance-} . tail {-drop the original-} $ 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 {-to Parser-monad-} 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 {-not a Pawn-} let
                                                mkNormalMoveType destination    = Attribute.MoveType.mkNormalMoveType (getMaybeRank destination) Nothing {-promotion-}

                                                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 {-to Parser-monad-} . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination
                                                        sourceCandidates        -> Poly.oneOf' [
                                                                show &&& return {-to Parser-monad-} $ qualifiedMove |
                                                                        source  <- sourceCandidates,-- Attempt to resolve the ambiguity by playing subsequent moves.
                                                                        let qualifiedMove       = Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,
                                                                        Model.Game.isValidQualifiedMove qualifiedMove game
                                                         ] -- List-comprehension.
                                        in Poly.oneOf' [
                                                (
                                                        "Fully qualified move", -- N.B. this scenario occurs when there are identical pieces on both the same row & the same column, as the intended attacker; i.e. after a promotion.
                                                        do
                                                                source          <- coordinatesParser
                                                                destination     <- Control.Applicative.optional captureParser >> coordinatesParser

                                                                return {-to Parser-monad-} . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination
                                                ), (
                                                        "Partially qualified move",     -- This scenario occurs if there's an identical piece on either the same row or the same column, as the intended attacker.
                                                        do
                                                                sourceFilter    <- Poly.oneOf' [
                                                                        (
                                                                                "Abscissa qualification",
                                                                                (
                                                                                        \x -> filter $ (== x) . Cartesian.Coordinates.getX
                                                                                ) `fmap` abscissaParser
                                                                        ), (
                                                                                "Ordinate qualification",
                                                                                (
                                                                                        \y -> filter $ (== y) . Cartesian.Coordinates.getY
                                                                                ) `fmap` ordinateParser
                                                                        )
                                                                 ] -- Build a filter from the source-qualifier.

                                                                destination     <- Control.Applicative.optional captureParser >> coordinatesParser

                                                                resolveQualifiedMove destination . sourceFilter $ findAttacksBy destination
                                                ), (
                                                        "Unqualified move",     -- The most likely scenario, where the intended attacker is unambiguous.
                                                        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 {-to Parser-monad-} $ 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 {-to Parser-monad-} $ Component.QualifiedMove.mkQualifiedMove kingsMove moveType
                        ) (
                                Data.Maybe.listToMaybe shortCastlingMoves
                        )
                ) -- TODO: for some reason, lazy-parsing with ghc-8.0.1 & polyparse-1.12 conflates "O-O-O" with "O-O"; confirm.
         ]

        _       <- Control.Applicative.optional (Poly.satisfyMsg (`elem` [checkFlag, checkMateFlag]) "Check") >> Control.Applicative.optional moveSuffixAnnotationParser

        fmap fromQualifiedMove $ if validateMoves
                then Data.Maybe.maybe (return {-to Parser-monad-} qualifiedMove) (Poly.failBad . showString "failed: ") $ Model.Game.validateQualifiedMove qualifiedMove game
                else return {-to Parser-monad-} 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 {-capture-}
                                                        ) <$> Control.Applicative.optional promotionParser
                                                 ) . Data.List.find (
                                                        Data.Maybe.maybe False {-no piece-} (== piece) . getMaybePiece
                                                 ) . Data.Maybe.catMaybes . take 2 {-maximum Pawn-advance-} . tail {-drop the original-} $ 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 {-to ParsecT-monad-} enPassantToken
                                                                                else fail undefined

                                                                return {-to ParsecT-monad-} Attribute.MoveType.enPassant
                                                ) <|> (
                                                        Attribute.MoveType.mkNormalMoveType maybeDestinationRank <$> Control.Applicative.optional promotionParser
                                                )
                                         ) . Data.List.find (
                                                (== x) . Cartesian.Coordinates.getX
                                         ) $ findAttacksBy destination
                                else {-not a Pawn-} let
                                        mkNormalMoveType destination    = Attribute.MoveType.mkNormalMoveType (getMaybeRank destination) Nothing {-promotion-}

                                        resolveQualifiedMove destination candidates     = case candidates of
                                                []                      -> fail . showString "Failed to locate any " . shows piece . showString " able to move to " $ shows destination "."
                                                [source]                -> return {-to ParsecT-monad-} . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination
                                                sourceCandidates        -> Parsec.choice [
                                                        Parsec.try $ return {-to ParsecT-monad-} qualifiedMove |
                                                                source  <- sourceCandidates,-- Attempt to resolve the ambiguity by playing subsequent moves.
                                                                let qualifiedMove       = Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,
                                                                Model.Game.isValidQualifiedMove qualifiedMove game
                                                 ] -- List-comprehension.
                                in Parsec.choice [
                                        Parsec.try $ do -- N.B. this scenario occurs when there are identical pieces on both the same row & the same column, as the intended attacker; i.e. after a promotion.
                                                source          <- coordinatesParser    <?> "Source"

                                                Parsec.optional captureParser           <?> "Optional capture"

                                                destination     <- coordinatesParser    <?> "Destination"

                                                return {-to ParsecT-monad-} . Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,
                                        Parsec.try $ do -- This scenario occurs if there's an identical piece on either the same row or the same column, as the intended attacker.
                                                sourceFilter    <- (
                                                        (
                                                                \x -> filter $ (== x) . Cartesian.Coordinates.getX
                                                        ) <$> abscissaParser
                                                 ) <|> (
                                                        (
                                                                \y -> filter $ (== y) . Cartesian.Coordinates.getY
                                                        ) <$> ordinateParser
                                                 ) -- Build a filter from the source-qualifier.

                                                Parsec.optional captureParser           <?> "Optional capture"

                                                destination     <- coordinatesParser    <?> "Destination"

                                                resolveQualifiedMove destination . sourceFilter $ findAttacksBy destination,
                                        do      -- The most likely scenario, where the intended attacker is unambiguous.
                                                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 {-to ParsecT-monad-} $ 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 {-to ParsecT-monad-} $ 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 {-to ParsecT-monad-} qualifiedMove) (fail . showString "Failed: ") $ Model.Game.validateQualifiedMove qualifiedMove game
                else return {-to ParsecT-monad-} qualifiedMove
#endif

-- | Represent a /rank/ in SAN.
fromRank :: Attribute.Rank.Rank -> Char
fromRank        = Data.Char.toUpper . head . show

-- | Translate from SAN to a /rank/.
toRank :: Char -> Attribute.Rank.Rank
toRank  = read . return {-to List-monad-}