{-# LANGUAGE CPP, LambdaCase #-}
{-
	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,
-- * Functions
	showsTurn,
	showTurn,
	showsMove,
	showMove,
	movePiece,
--	rankParser,
--	captureParser,
--	moveSuffixAnnotationParser,
	parser,
	fromRank,
	toRank,
-- ** Constructors
	fromQualifiedMove
) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
import qualified	BishBosh.Component.CastlingMove		as Component.CastlingMove
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.Notation.PureCoordinate	as Notation.PureCoordinate
import qualified	BishBosh.Property.ForsythEdwards	as Property.ForsythEdwards
import qualified	BishBosh.Rule.GameTerminationReason	as Rule.GameTerminationReason
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.Type.Length			as Type.Length
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 :: Char
captureFlag		= Char
'x'

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

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

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

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

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

-- | Constant indication of a short @King@-side Castle.
shortCastleToken :: String
shortCastleToken :: String
shortCastleToken	= String
"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 :: String
moveSuffixAnnotations	= String
"!?"

-- | Defines a /move/, to enable i/o in /StandardAlgebraic/-notation.
newtype StandardAlgebraic x y	= MkStandardAlgebraic {
	StandardAlgebraic x y -> QualifiedMove x y
getQualifiedMove	:: Component.QualifiedMove.QualifiedMove x y
} deriving (StandardAlgebraic x y -> StandardAlgebraic x y -> Bool
(StandardAlgebraic x y -> StandardAlgebraic x y -> Bool)
-> (StandardAlgebraic x y -> StandardAlgebraic x y -> Bool)
-> Eq (StandardAlgebraic x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y.
(Eq x, Eq y) =>
StandardAlgebraic x y -> StandardAlgebraic x y -> Bool
/= :: StandardAlgebraic x y -> StandardAlgebraic x y -> Bool
$c/= :: forall x y.
(Eq x, Eq y) =>
StandardAlgebraic x y -> StandardAlgebraic x y -> Bool
== :: StandardAlgebraic x y -> StandardAlgebraic x y -> Bool
$c== :: forall x y.
(Eq x, Eq y) =>
StandardAlgebraic x y -> StandardAlgebraic x y -> Bool
Eq, Int -> StandardAlgebraic x y -> ShowS
[StandardAlgebraic x y] -> ShowS
StandardAlgebraic x y -> String
(Int -> StandardAlgebraic x y -> ShowS)
-> (StandardAlgebraic x y -> String)
-> ([StandardAlgebraic x y] -> ShowS)
-> Show (StandardAlgebraic x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y.
(Show x, Show y) =>
Int -> StandardAlgebraic x y -> ShowS
forall x y. (Show x, Show y) => [StandardAlgebraic x y] -> ShowS
forall x y. (Show x, Show y) => StandardAlgebraic x y -> String
showList :: [StandardAlgebraic x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [StandardAlgebraic x y] -> ShowS
show :: StandardAlgebraic x y -> String
$cshow :: forall x y. (Show x, Show y) => StandardAlgebraic x y -> String
showsPrec :: Int -> StandardAlgebraic x y -> ShowS
$cshowsPrec :: forall x y.
(Show x, Show y) =>
Int -> StandardAlgebraic x y -> ShowS
Show)

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

-- | 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 Type.Length.X Type.Length.Y -> Model.Game.Game Type.Length.X Type.Length.Y -> ShowS #-}
showsTurn :: Bool -> Turn x y -> Game x y -> ShowS
showsTurn Bool
explicitEnPassant Turn x y
turn Game x y
game
	| Just Rank
sourceRank <- (Piece -> Rank) -> Maybe Piece -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Piece -> Rank
Component.Piece.getRank (Maybe Piece -> Maybe Rank)
-> (MaybePieceByCoordinates x y -> Maybe Piece)
-> MaybePieceByCoordinates x y
-> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
source (MaybePieceByCoordinates x y -> Maybe Rank)
-> MaybePieceByCoordinates x y -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board	= (
		if Rank
sourceRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.Pawn
			then (
				if Bool
isCapture
					then ShowS
showsX ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsCapture
					else ShowS
forall a. a -> a
id
			) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsDestination ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Bool
isEnPassant
				then if Bool
explicitEnPassant
					then String -> ShowS
showString String
enPassantToken
					else ShowS
forall a. a -> a
id
				else ShowS -> (Rank -> ShowS) -> Maybe Rank -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
forall a. a -> a
id (
					\Rank
promotionRank -> Char -> ShowS
showChar Char
promotionFlag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> ShowS
showsRank Rank
promotionRank
				) (Maybe Rank -> ShowS) -> Maybe Rank -> ShowS
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank MoveType
moveType
			else {-not a Pawn-} case MoveType
moveType of
				Attribute.MoveType.Castle Bool
isShort	-> String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ if Bool
isShort
					then String
shortCastleToken
					else String
longCastleToken
				MoveType
_ {-not a castling-}			-> Rank -> ShowS
showsRank Rank
sourceRank ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					case Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Coordinates x y
source {-search for alternatives-} ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ Piece -> Coordinates x y -> Board x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Piece -> Coordinates x y -> Board x y -> [Coordinates x y]
State.Board.findAttacksBy (
						LogicalColour -> Rank -> Piece
Component.Piece.mkPiece (Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game) Rank
sourceRank
					) Coordinates x y
destination Board x y
board of
						[]		-> ShowS
forall a. a -> a
id	-- There're aren't any pieces of this rank which can perform this move.
						[Coordinates x y]
coordinates	-> case (Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
							(x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
source) (x -> Bool) -> (Coordinates x y -> x) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX
						 ) ([Coordinates x y] -> Bool)
-> ([Coordinates x y] -> Bool) -> [Coordinates x y] -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
							(y -> y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY Coordinates x y
source) (y -> Bool) -> (Coordinates x y -> y) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY
						 ) ([Coordinates x y] -> (Bool, Bool))
-> [Coordinates x y] -> (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ [Coordinates x y]
coordinates of
							(Bool
True, Bool
True)	-> ShowS
showsX ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsY	-- There're other pieces of this rank, some with similar X-coordinate & some with similar Y-coordinate.
							(Bool
_, Bool
False)	-> ShowS
showsY		-- There's another piece of this rank & X-coordinate; specify Y-coordinate to disambiguate.
							(Bool, Bool)
_		-> ShowS
showsX		-- There's anoher piece of this rank, but neither X nor Y coordinates are similar.
				 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					if Bool
isCapture
						then ShowS
showsCapture
						else ShowS
forall a. a -> a
id
				 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsDestination
	) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		if Maybe LogicalColour -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust (Maybe LogicalColour -> Bool) -> Maybe LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe LogicalColour
forall x y. Game x y -> Maybe LogicalColour
Model.Game.getMaybeChecked Game x y
game'
			then Char -> ShowS
showChar (Char -> ShowS) -> Char -> ShowS
forall a b. (a -> b) -> a -> b
$ if Bool
-> (GameTerminationReason -> Bool)
-> Maybe GameTerminationReason
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False GameTerminationReason -> Bool
Rule.GameTerminationReason.isCheckMate (Maybe GameTerminationReason -> Bool)
-> Maybe GameTerminationReason -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe GameTerminationReason
forall x y. Game x y -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason Game x y
game'
				then Char
checkMateFlag
				else Char
checkFlag
			else ShowS
forall a. a -> a
id
	)
	| Bool
otherwise	= Exception -> ShowS
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> ShowS) -> (String -> Exception) -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.ContextualNotation.StandardAlgebraic.showsTurn:\tno piece exists at " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
Notation.PureCoordinate.showsCoordinates Coordinates x y
source ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Game x y -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN Game x y
game String
"."
	where
		((Coordinates x y
source, Coordinates x y
destination), MoveType
moveType)	= (Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (Move x y -> Coordinates x y)
-> Move x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination) (Move x y -> (Coordinates x y, Coordinates x y))
-> (QualifiedMove x y -> Move x y)
-> QualifiedMove x y
-> (Coordinates x y, Coordinates x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> (Coordinates x y, Coordinates x y))
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> ((Coordinates x y, Coordinates x y), MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y
 -> ((Coordinates x y, Coordinates x y), MoveType))
-> QualifiedMove x y
-> ((Coordinates x y, Coordinates x y), MoveType)
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
		board :: Board x y
board					= Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game

		isEnPassant, isCapture :: Bool
		isEnPassant :: Bool
isEnPassant	= MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType
		isCapture :: Bool
isCapture	= Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isOccupied Coordinates x y
destination (Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board) Bool -> Bool -> Bool
|| Bool
isEnPassant

		showsRank :: Attribute.Rank.Rank -> ShowS
		showsRank :: Rank -> ShowS
showsRank Rank
rank	= Char -> ShowS
showChar (Char -> ShowS) -> Char -> ShowS
forall a b. (a -> b) -> a -> b
$ Rank -> Char
fromRank Rank
rank

		showsCapture, showsX, showsY, showsDestination :: ShowS
		showsCapture :: ShowS
showsCapture		= Char -> ShowS
showChar Char
captureFlag
		(ShowS
showsX, ShowS
showsY)	= Coordinates x y -> (ShowS, ShowS)
forall x y. (Enum x, Enum y) => Coordinates x y -> (ShowS, ShowS)
Notation.PureCoordinate.encode Coordinates x y
source
		showsDestination :: ShowS
showsDestination	= Coordinates x y -> ShowS
forall x y. (Enum x, Enum y) => Coordinates x y -> ShowS
Notation.PureCoordinate.showsCoordinates Coordinates x y
destination

		game' :: Game x y
game'	= Turn x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Turn x y -> Transformation x y
Model.Game.takeTurn Turn x y
turn Game x y
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 Type.Length.X Type.Length.Y -> Model.Game.Game Type.Length.X Type.Length.Y -> String #-}
showTurn :: Bool -> Turn x y -> Game x y -> String
showTurn Bool
explicitEnPassant Turn x y
turn Game x y
game	= Bool -> Turn x y -> Game x y -> ShowS
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Bool -> Turn x y -> Game x y -> ShowS
showsTurn Bool
explicitEnPassant Turn x y
turn Game x y
game String
""

-- | 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 Type.Length.X Type.Length.Y -> Model.Game.Game Type.Length.X Type.Length.Y -> ShowS #-}
showsMove :: Bool -> QualifiedMove x y -> Game x y -> ShowS
showsMove Bool
explicitEnPassant QualifiedMove x y
qualifiedMove Game x y
game	= Bool -> Turn x y -> Game x y -> ShowS
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Bool -> Turn x y -> Game x y -> ShowS
showsTurn Bool
explicitEnPassant (
	Turn x y -> Maybe (Turn x y) -> Turn x y
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
		Exception -> Turn x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn x y) -> Exception -> Turn x y
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.ContextualNotation.StandardAlgebraic.showsMove:\tModel.Game.maybeLastTurn failed."
	) (Maybe (Turn x y) -> Turn x y)
-> (Game x y -> Maybe (Turn x y)) -> Game x y -> Turn x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
Model.Game.maybeLastTurn (Game x y -> Turn x y) -> Game x y -> Turn x y
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
Model.Game.applyQualifiedMove QualifiedMove x y
qualifiedMove Game x y
game
 ) Game x y
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 Type.Length.X Type.Length.Y -> Model.Game.Game Type.Length.X Type.Length.Y -> String #-}
showMove :: Bool -> QualifiedMove x y -> Game x y -> String
showMove Bool
explicitEnPassant QualifiedMove x y
qualifiedMove Game x y
game	= Bool -> QualifiedMove x y -> Game x y -> ShowS
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Bool -> QualifiedMove x y -> Game x y -> ShowS
showsMove Bool
explicitEnPassant QualifiedMove x y
qualifiedMove Game x y
game String
""

-- | 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 Type.Length.X Type.Length.Y -> Model.Game.Transformation Type.Length.X Type.Length.Y #-}
movePiece :: StandardAlgebraic x y -> Transformation x y
movePiece MkStandardAlgebraic { getQualifiedMove :: forall x y. StandardAlgebraic x y -> QualifiedMove x y
getQualifiedMove = QualifiedMove x y
qualifiedMove }	= QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
Model.Game.applyQualifiedMove QualifiedMove x y
qualifiedMove

#ifdef USE_POLYPARSE
-- | Parse the /rank/ of the /piece/ being moved.
rankParser :: Text.Poly.TextParser Attribute.Rank.Rank
rankParser :: TextParser Rank
rankParser	= Char -> Rank
toRank (Char -> Rank) -> Parser Char Char -> TextParser Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Char -> Bool) -> String -> Parser Char Char
forall t. Show t => (t -> Bool) -> String -> Parser t t
Poly.satisfyMsg (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Rank -> Char) -> [Rank] -> String
forall a b. (a -> b) -> [a] -> [b]
map Rank -> Char
fromRank [Rank]
Attribute.Rank.pieces) String
Attribute.Rank.tag

-- | Parse the flag which denotes capture.
captureParser :: Text.Poly.TextParser Char
captureParser :: Parser Char Char
captureParser	= (Char -> Bool) -> String -> Parser Char Char
forall t. Show t => (t -> Bool) -> String -> Parser t t
Poly.satisfyMsg (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
captureFlag) String
"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 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 :: TextParser String
moveSuffixAnnotationParser	= TextParser ()
Text.Poly.spaces TextParser () -> TextParser String -> TextParser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char Char -> TextParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Control.Applicative.some ([(String, Parser Char Char)] -> Parser Char Char
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' ([(String, Parser Char Char)] -> Parser Char Char)
-> [(String, Parser Char Char)] -> Parser Char Char
forall a b. (a -> b) -> a -> b
$ (Char -> (String, Parser Char Char))
-> String -> [(String, Parser Char Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> ([Char
c], (Char -> Bool) -> String -> Parser Char Char
forall t. Show t => (t -> Bool) -> String -> Parser t t
Poly.satisfyMsg (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) String
"Move Suffix-annotation")) String
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 Type.Length.X Type.Length.Y -> Text.Poly.TextParser (StandardAlgebraic Type.Length.X Type.Length.Y) #-}
parser :: Bool -> Bool -> Game x y -> TextParser (StandardAlgebraic x y)
parser Bool
explicitEnPassant Bool
validateMoves Game x y
game	= let
	nextLogicalColour :: LogicalColour
nextLogicalColour			= Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
Model.Game.getNextLogicalColour Game x y
game
	(CastlingMove x y
longCastlingMove, CastlingMove x y
shortCastlingMove)	= LogicalColour -> (CastlingMove x y, CastlingMove x y)
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> (CastlingMove x y, CastlingMove x y)
Component.CastlingMove.getLongAndShortMoves LogicalColour
nextLogicalColour
	board :: Board x y
board					= Game x y -> Board x y
forall x y. Game x y -> Board x y
Model.Game.getBoard Game x y
game
	getMaybePiece :: Coordinates x y -> Maybe Piece
getMaybePiece				= (Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
`State.MaybePieceByCoordinates.dereference` Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board)
	getMaybeRank :: Coordinates x y -> Maybe Rank
getMaybeRank				= (Piece -> Rank) -> Maybe Piece -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Piece -> Rank
Component.Piece.getRank (Maybe Piece -> Maybe Rank)
-> (Coordinates x y -> Maybe Piece)
-> Coordinates x y
-> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> Maybe Piece
getMaybePiece
 in do
	QualifiedMove x y
qualifiedMove	<- TextParser ()
Text.Poly.spaces TextParser ()
-> Parser Char (QualifiedMove x y)
-> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, Parser Char (QualifiedMove x y))]
-> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
		(
			String
"Non-castling move",
			do
				Rank
rank	<- Rank -> Maybe Rank -> Rank
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Rank
Attribute.Rank.Pawn (Maybe Rank -> Rank) -> Parser Char (Maybe Rank) -> TextParser Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TextParser Rank -> Parser Char (Maybe Rank)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional TextParser Rank
rankParser

				let
					piece :: Component.Piece.Piece
					piece :: Piece
piece	= LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
nextLogicalColour Rank
rank

					findAttacksBy :: Coordinates x y -> [Coordinates x y]
findAttacksBy Coordinates x y
destination	= Piece -> Coordinates x y -> Board x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Piece -> Coordinates x y -> Board x y -> [Coordinates x y]
State.Board.findAttacksBy Piece
piece Coordinates x y
destination Board x y
board

				if Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.Pawn
					then let
						promotionParser :: Text.Poly.TextParser Attribute.Rank.Rank
						promotionParser :: TextParser Rank
promotionParser	= Char -> TextParser ()
Text.Poly.char Char
promotionFlag TextParser () -> TextParser Rank -> TextParser Rank
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser Rank
rankParser
					in [(String, Parser Char (QualifiedMove x y))]
-> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
						(
							String
"Pawn-advance",
							do
								Coordinates x y
destination	<- TextParser (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
TextParser (Coordinates x y)
Notation.PureCoordinate.coordinatesParser

								Parser Char (QualifiedMove x y)
-> (Coordinates x y -> Parser Char (QualifiedMove x y))
-> Maybe (Coordinates x y)
-> Parser Char (QualifiedMove x y)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
									do
										String
context	<- Parser Char Char -> TextParser () -> TextParser String
forall (p :: * -> *) a z.
(PolyParse p, Show a) =>
p a -> p z -> p [a]
Poly.manyFinally' Parser Char Char
forall t. Parser t t
Poly.next (TextParser () -> TextParser String)
-> TextParser () -> TextParser String
forall a b. (a -> b) -> a -> b
$ Char -> TextParser ()
Text.Poly.char Char
'\n'

										String -> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char (QualifiedMove x y))
-> ShowS -> String -> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to locate any " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
piece ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" which can advance to " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> ShowS
forall a. Show a => a -> ShowS
shows Coordinates x y
destination ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Before " (String -> Parser Char (QualifiedMove x y))
-> String -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
context String
"."
								 ) (
									\Coordinates x y
source -> (
										Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination) (MoveType -> QualifiedMove x y)
-> (Maybe Rank -> MoveType) -> Maybe Rank -> QualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
forall a. Maybe a
Nothing {-capture-}
									) (Maybe Rank -> QualifiedMove x y)
-> Parser Char (Maybe Rank) -> Parser Char (QualifiedMove x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TextParser Rank -> Parser Char (Maybe Rank)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional TextParser Rank
promotionParser
								 ) (Maybe (Coordinates x y) -> Parser Char (QualifiedMove x y))
-> ([Maybe (Coordinates x y)] -> Maybe (Coordinates x y))
-> [Maybe (Coordinates x y)]
-> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Bool)
-> [Coordinates x y] -> Maybe (Coordinates x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
									(Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
piece) (Maybe Piece -> Bool)
-> (Coordinates x y -> Maybe Piece) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> Maybe Piece
getMaybePiece
								 ) ([Coordinates x y] -> Maybe (Coordinates x y))
-> ([Maybe (Coordinates x y)] -> [Coordinates x y])
-> [Maybe (Coordinates x y)]
-> Maybe (Coordinates x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Coordinates x y)] -> [Coordinates x y]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes ([Maybe (Coordinates x y)] -> [Coordinates x y])
-> ([Maybe (Coordinates x y)] -> [Maybe (Coordinates x y)])
-> [Maybe (Coordinates x y)]
-> [Coordinates x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Maybe (Coordinates x y)] -> [Maybe (Coordinates x y)]
forall a. Int -> [a] -> [a]
take Int
2 {-maximum Pawn-advance-} ([Maybe (Coordinates x y)] -> [Maybe (Coordinates x y)])
-> ([Maybe (Coordinates x y)] -> [Maybe (Coordinates x y)])
-> [Maybe (Coordinates x y)]
-> [Maybe (Coordinates x y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Coordinates x y)] -> [Maybe (Coordinates x y)]
forall a. [a] -> [a]
tail {-drop the original-} ([Maybe (Coordinates x y)] -> Parser Char (QualifiedMove x y))
-> [Maybe (Coordinates x y)] -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ (Maybe (Coordinates x y) -> Maybe (Coordinates x y))
-> Maybe (Coordinates x y) -> [Maybe (Coordinates x y)]
forall a. (a -> a) -> a -> [a]
iterate (
									Maybe (Coordinates x y)
-> (Coordinates x y -> Maybe (Coordinates x y))
-> Maybe (Coordinates x y)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour -> Coordinates x y -> Maybe (Coordinates x y)
forall y x.
(Enum y, Ord y) =>
LogicalColour -> Coordinates x y -> Maybe (Coordinates x y)
Cartesian.Coordinates.maybeRetreat LogicalColour
nextLogicalColour
								 ) (Maybe (Coordinates x y) -> [Maybe (Coordinates x y)])
-> Maybe (Coordinates x y) -> [Maybe (Coordinates x y)]
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Maybe (Coordinates x y)
forall a. a -> Maybe a
Just Coordinates x y
destination
						), (
							String
"Pawn-capture",
							do
								x
x		<- TextParser x
forall x. Enum x => TextParser x
Notation.PureCoordinate.abscissaParser
								Char
_		<- Parser Char Char
captureParser
								Coordinates x y
destination	<- TextParser (Coordinates x y) -> TextParser (Coordinates x y)
forall (p :: * -> *) a. Commitment p => p a -> p a
Poly.commit TextParser (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
TextParser (Coordinates x y)
Notation.PureCoordinate.coordinatesParser

								let maybeDestinationRank :: Maybe Rank
maybeDestinationRank	= Coordinates x y -> Maybe Rank
getMaybeRank Coordinates x y
destination

								Parser Char (QualifiedMove x y)
-> (Coordinates x y -> Parser Char (QualifiedMove x y))
-> Maybe (Coordinates x y)
-> Parser Char (QualifiedMove x y)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
									do
										String
context	<- Parser Char Char -> TextParser () -> TextParser String
forall (p :: * -> *) a z.
(PolyParse p, Show a) =>
p a -> p z -> p [a]
Poly.manyFinally' Parser Char Char
forall t. Parser t t
Poly.next (TextParser () -> TextParser String)
-> TextParser () -> TextParser String
forall a b. (a -> b) -> a -> b
$ Char -> TextParser ()
Text.Poly.char Char
'\n'

										String -> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char (QualifiedMove x y))
-> ShowS -> String -> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to locate any " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
piece ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" which can capture " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> ShowS
forall a. Show a => a -> ShowS
shows Coordinates x y
destination ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" from abscissa" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ShowS
forall a. Show a => a -> ShowS
shows x
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Before " (String -> Parser Char (QualifiedMove x y))
-> String -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
context String
"."
								 ) (
									\Coordinates x y
source -> Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
										Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
									) (MoveType -> QualifiedMove x y)
-> Parser Char MoveType -> Parser Char (QualifiedMove x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [(String, Parser Char MoveType)] -> Parser Char MoveType
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
										(
											String
"En-passant",
											do
												if Bool
explicitEnPassant
													then String -> TextParser ()
Text.Poly.string String
enPassantToken
													else Bool -> TextParser () -> TextParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when (Maybe Rank -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe Rank
maybeDestinationRank) (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
forall a. HasCallStack => a
undefined

												MoveType -> Parser Char MoveType
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} MoveType
Attribute.MoveType.enPassant
										), (
											String
"Normal pawn capture",
											Parser Char MoveType -> Parser Char MoveType
forall (p :: * -> *) a. Commitment p => p a -> p a
Poly.commit (Parser Char MoveType -> Parser Char MoveType)
-> Parser Char MoveType -> Parser Char MoveType
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeDestinationRank (Maybe Rank -> MoveType)
-> Parser Char (Maybe Rank) -> Parser Char MoveType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TextParser Rank -> Parser Char (Maybe Rank)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional TextParser Rank
promotionParser
										)
									]
								 ) (Maybe (Coordinates x y) -> Parser Char (QualifiedMove x y))
-> ([Coordinates x y] -> Maybe (Coordinates x y))
-> [Coordinates x y]
-> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Bool)
-> [Coordinates x y] -> Maybe (Coordinates x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
									(x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
x) (x -> Bool) -> (Coordinates x y -> x) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX
								 ) ([Coordinates x y] -> Parser Char (QualifiedMove x y))
-> [Coordinates x y] -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> [Coordinates x y]
findAttacksBy Coordinates x y
destination
						)
					]
					else {-not a Pawn-} let
						mkNormalMoveType :: Coordinates x y -> MoveType
mkNormalMoveType Coordinates x y
destination	= Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType (Coordinates x y -> Maybe Rank
getMaybeRank Coordinates x y
destination) Maybe Rank
forall a. Maybe a
Nothing {-promotion-}

						resolveQualifiedMove :: Coordinates x y
-> [Coordinates x y] -> Parser Char (QualifiedMove x y)
resolveQualifiedMove Coordinates x y
destination	= \case
							[]			-> do
								String
context	<- Parser Char Char -> TextParser () -> TextParser String
forall (p :: * -> *) a z.
(PolyParse p, Show a) =>
p a -> p z -> p [a]
Poly.manyFinally' Parser Char Char
forall t. Parser t t
Poly.next (TextParser () -> TextParser String)
-> TextParser () -> TextParser String
forall a b. (a -> b) -> a -> b
$ Char -> TextParser ()
Text.Poly.char Char
'\n'

								String -> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char (QualifiedMove x y))
-> ShowS -> String -> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed to locate any " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
piece ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" able to move to " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> ShowS
forall a. Show a => a -> ShowS
shows Coordinates x y
destination ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Before " (String -> Parser Char (QualifiedMove x y))
-> String -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
context String
"."
							[Coordinates x y
source]		-> QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (QualifiedMove x y -> Parser Char (QualifiedMove x y))
-> (MoveType -> QualifiedMove x y)
-> MoveType
-> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination) (MoveType -> Parser Char (QualifiedMove x y))
-> MoveType -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> MoveType
mkNormalMoveType Coordinates x y
destination
							[Coordinates x y]
sourceCandidates	-> [(String, Parser Char (QualifiedMove x y))]
-> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
								QualifiedMove x y -> String
forall a. Show a => a -> String
show (QualifiedMove x y -> String)
-> (QualifiedMove x y -> Parser Char (QualifiedMove x y))
-> QualifiedMove x y
-> (String, Parser Char (QualifiedMove x y))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (QualifiedMove x y -> (String, Parser Char (QualifiedMove x y)))
-> QualifiedMove x y -> (String, Parser Char (QualifiedMove x y))
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y
qualifiedMove |
									Coordinates x y
source	<- [Coordinates x y]
sourceCandidates,-- Attempt to resolve the ambiguity by playing subsequent moves.
									let qualifiedMove :: QualifiedMove x y
qualifiedMove	= Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> MoveType
mkNormalMoveType Coordinates x y
destination,
									QualifiedMove x y -> Game x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Game x y -> Bool
Model.Game.isValidQualifiedMove QualifiedMove x y
qualifiedMove Game x y
game
							 ] -- List-comprehension.
					in [(String, Parser Char (QualifiedMove x y))]
-> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
						(
							String
"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
								Coordinates x y
source		<- TextParser (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
TextParser (Coordinates x y)
Notation.PureCoordinate.coordinatesParser
								Coordinates x y
destination	<- Parser Char Char -> Parser Char (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional Parser Char Char
captureParser Parser Char (Maybe Char)
-> TextParser (Coordinates x y) -> TextParser (Coordinates x y)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
TextParser (Coordinates x y)
Notation.PureCoordinate.coordinatesParser

								QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (QualifiedMove x y -> Parser Char (QualifiedMove x y))
-> (MoveType -> QualifiedMove x y)
-> MoveType
-> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination) (MoveType -> Parser Char (QualifiedMove x y))
-> MoveType -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> MoveType
mkNormalMoveType Coordinates x y
destination
						), (
							String
"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
								[Coordinates x y] -> [Coordinates x y]
sourceFilter	<- [(String, Parser Char ([Coordinates x y] -> [Coordinates x y]))]
-> Parser Char ([Coordinates x y] -> [Coordinates x y])
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
									(
										String
"Abscissa qualification",
										(
											\x
x -> (Coordinates x y -> Bool) -> [Coordinates x y] -> [Coordinates x y]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Coordinates x y -> Bool)
 -> [Coordinates x y] -> [Coordinates x y])
-> (Coordinates x y -> Bool)
-> [Coordinates x y]
-> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ (x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
x) (x -> Bool) -> (Coordinates x y -> x) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX
										) (x -> [Coordinates x y] -> [Coordinates x y])
-> TextParser x
-> Parser Char ([Coordinates x y] -> [Coordinates x y])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TextParser x
forall x. Enum x => TextParser x
Notation.PureCoordinate.abscissaParser
									), (
										String
"Ordinate qualification",
										(
											\y
y -> (Coordinates x y -> Bool) -> [Coordinates x y] -> [Coordinates x y]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Coordinates x y -> Bool)
 -> [Coordinates x y] -> [Coordinates x y])
-> (Coordinates x y -> Bool)
-> [Coordinates x y]
-> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ (y -> y -> Bool
forall a. Eq a => a -> a -> Bool
== y
y) (y -> Bool) -> (Coordinates x y -> y) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY
										) (y -> [Coordinates x y] -> [Coordinates x y])
-> Parser Char y
-> Parser Char ([Coordinates x y] -> [Coordinates x y])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser Char y
forall x. Enum x => TextParser x
Notation.PureCoordinate.ordinateParser
									)
								 ] -- Build a filter from the source-qualifier.

								Coordinates x y
destination	<- Parser Char Char -> Parser Char (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional Parser Char Char
captureParser Parser Char (Maybe Char)
-> TextParser (Coordinates x y) -> TextParser (Coordinates x y)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
TextParser (Coordinates x y)
Notation.PureCoordinate.coordinatesParser

								Coordinates x y
-> [Coordinates x y] -> Parser Char (QualifiedMove x y)
resolveQualifiedMove Coordinates x y
destination ([Coordinates x y] -> Parser Char (QualifiedMove x y))
-> ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y]
-> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates x y] -> [Coordinates x y]
sourceFilter ([Coordinates x y] -> Parser Char (QualifiedMove x y))
-> [Coordinates x y] -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> [Coordinates x y]
findAttacksBy Coordinates x y
destination
						), (
							String
"Unqualified move",	-- The most likely scenario, where the intended attacker is unambiguous.
							Parser Char (QualifiedMove x y) -> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. Commitment p => p a -> p a
Poly.commit (Parser Char (QualifiedMove x y)
 -> Parser Char (QualifiedMove x y))
-> Parser Char (QualifiedMove x y)
-> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ do
								Coordinates x y
destination	<- Parser Char Char -> Parser Char (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional Parser Char Char
captureParser Parser Char (Maybe Char)
-> TextParser (Coordinates x y) -> TextParser (Coordinates x y)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
TextParser (Coordinates x y)
Notation.PureCoordinate.coordinatesParser

								Coordinates x y
-> [Coordinates x y] -> Parser Char (QualifiedMove x y)
resolveQualifiedMove Coordinates x y
destination ([Coordinates x y] -> Parser Char (QualifiedMove x y))
-> [Coordinates x y] -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> [Coordinates x y]
findAttacksBy Coordinates x y
destination
						)
					]
		), (
			String
"Long castle",
			String -> TextParser ()
Text.Poly.string String
longCastleToken TextParser ()
-> Parser Char (QualifiedMove x y)
-> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (
				(Move x y -> MoveType -> QualifiedMove x y)
-> (Move x y, MoveType) -> QualifiedMove x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove ((Move x y, MoveType) -> QualifiedMove x y)
-> (Move x y, MoveType) -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ (CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove (CastlingMove x y -> Move x y)
-> (CastlingMove x y -> MoveType)
-> CastlingMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CastlingMove x y -> MoveType
forall x y. CastlingMove x y -> MoveType
Component.CastlingMove.getMoveType) CastlingMove x y
longCastlingMove
			)
		), (
			String
"Short castle",
			String -> TextParser ()
Text.Poly.string String
shortCastleToken TextParser ()
-> Parser Char (QualifiedMove x y)
-> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (
				(Move x y -> MoveType -> QualifiedMove x y)
-> (Move x y, MoveType) -> QualifiedMove x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove ((Move x y, MoveType) -> QualifiedMove x y)
-> (Move x y, MoveType) -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ (CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove (CastlingMove x y -> Move x y)
-> (CastlingMove x y -> MoveType)
-> CastlingMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CastlingMove x y -> MoveType
forall x y. CastlingMove x y -> MoveType
Component.CastlingMove.getMoveType) CastlingMove x y
shortCastlingMove
			)
		) -- TODO: for some reason, lazy-parsing with ghc-8.0.1 & polyparse-1.12 conflates "O-O-O" with "O-O"; confirm.
	 ]

	Maybe String
_	<- Parser Char Char -> Parser Char (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional ((Char -> Bool) -> String -> Parser Char Char
forall t. Show t => (t -> Bool) -> String -> Parser t t
Poly.satisfyMsg (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
checkFlag, Char
checkMateFlag]) String
"Check") Parser Char (Maybe Char)
-> Parser Char (Maybe String) -> Parser Char (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser String -> Parser Char (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional TextParser String
moveSuffixAnnotationParser

	(QualifiedMove x y -> StandardAlgebraic x y)
-> Parser Char (QualifiedMove x y)
-> TextParser (StandardAlgebraic x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QualifiedMove x y -> StandardAlgebraic x y
forall x y. QualifiedMove x y -> StandardAlgebraic x y
fromQualifiedMove (Parser Char (QualifiedMove x y)
 -> TextParser (StandardAlgebraic x y))
-> Parser Char (QualifiedMove x y)
-> TextParser (StandardAlgebraic x y)
forall a b. (a -> b) -> a -> b
$ if Bool
validateMoves
		then Parser Char (QualifiedMove x y)
-> (String -> Parser Char (QualifiedMove x y))
-> Maybe String
-> Parser Char (QualifiedMove x y)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} QualifiedMove x y
qualifiedMove) (String -> Parser Char (QualifiedMove x y)
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char (QualifiedMove x y))
-> ShowS -> String -> Parser Char (QualifiedMove x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed: ") (Maybe String -> Parser Char (QualifiedMove x y))
-> Maybe String -> Parser Char (QualifiedMove x y)
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Game x y -> Maybe String
Model.Game.validateQualifiedMove QualifiedMove x y
qualifiedMove Game x y
game
		else QualifiedMove x y -> Parser Char (QualifiedMove x y)
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} QualifiedMove x y
qualifiedMove
#else /* Parsec */
	-> Parsec.Parser (StandardAlgebraic x y)
{-# SPECIALISE parser :: ExplicitEnPassant -> ValidateMoves -> Model.Game.Game Type.Length.X Type.Length.Y -> Parsec.Parser (StandardAlgebraic Type.Length.X Type.Length.Y) #-}
parser explicitEnPassant validateMoves game	= let
	nextLogicalColour			= Model.Game.getNextLogicalColour game
	(longCastlingMove, shortCastlingMove)	= Component.CastlingMove.getLongAndShortMoves 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	<- Notation.PureCoordinate.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 (
							(== Just piece) . getMaybePiece
						 ) . Data.Maybe.catMaybes . take 2 {-maximum Pawn-advance-} . tail {-drop the original-} $ iterate (
							>>= Cartesian.Coordinates.maybeRetreat nextLogicalColour
						 ) $ Just destination
				) <|> do
					x		<- Notation.PureCoordinate.abscissaParser <* captureParser
					destination	<- Notation.PureCoordinate.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		<- Notation.PureCoordinate.coordinatesParser	<?> "Source"

						Parsec.optional captureParser		<?> "Optional capture"

						destination	<- Notation.PureCoordinate.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
							) <$> Notation.PureCoordinate.abscissaParser
						 ) <|> (
							(
								\y -> filter $ (== y) . Cartesian.Coordinates.getY
							) <$> Notation.PureCoordinate.ordinateParser
						 ) -- Build a filter from the source-qualifier.

						Parsec.optional captureParser		<?> "Optional capture"

						destination	<- Notation.PureCoordinate.coordinatesParser	<?> "Destination"

						resolveQualifiedMove destination . sourceFilter $ findAttacksBy destination,
					do	-- The most likely scenario, where the intended attacker is unambiguous.
						Parsec.optional captureParser		<?> "Optional capture"

						destination	<- Notation.PureCoordinate.coordinatesParser	<?> "Unqualified destination"

						resolveQualifiedMove destination $ findAttacksBy destination
				],
		Parsec.try $ (
			Parsec.string longCastleToken	<?> "Long castle"
		) >> return {-to ParsecT-monad-} (
			uncurry Component.QualifiedMove.mkQualifiedMove $ (Component.CastlingMove.getKingsMove &&& Component.CastlingMove.getMoveType) longCastlingMove
		), (
			Parsec.string shortCastleToken	<?> "Short castle"
		) >> return {-to ParsecT-monad-} (
			uncurry Component.QualifiedMove.mkQualifiedMove $ (Component.CastlingMove.getKingsMove &&& Component.CastlingMove.getMoveType) shortCastlingMove
		)
	 ]

	_	<- 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 :: Rank -> Char
fromRank	= Char -> Char
Data.Char.toUpper (Char -> Char) -> (Rank -> Char) -> Rank -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head (String -> Char) -> (Rank -> String) -> Rank -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> String
forall a. Show a => a -> String
show

-- | Translate from SAN to a /rank/.
toRank :: Char -> Attribute.Rank.Rank
toRank :: Char -> Rank
toRank	= String -> Rank
forall a. Read a => String -> a
read (String -> Rank) -> (Char -> String) -> Char -> Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (m :: * -> *) a. Monad m => a -> m a
return {-to List-monad-}