{-# 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.Notation		as Notation.Notation
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	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 == 'L'
import qualified	Text.ParserCombinators.Poly.Lazy	as Poly
#	elif USE_POLYPARSE == 'P'
import qualified	Text.ParserCombinators.Poly.Plain	as Poly
#	else
#		error "USE_POLYPARSE invalid"
#	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	= MkStandardAlgebraic {
	StandardAlgebraic -> QualifiedMove
getQualifiedMove	:: Component.QualifiedMove.QualifiedMove
} deriving (StandardAlgebraic -> StandardAlgebraic -> Bool
(StandardAlgebraic -> StandardAlgebraic -> Bool)
-> (StandardAlgebraic -> StandardAlgebraic -> Bool)
-> Eq StandardAlgebraic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StandardAlgebraic -> StandardAlgebraic -> Bool
$c/= :: StandardAlgebraic -> StandardAlgebraic -> Bool
== :: StandardAlgebraic -> StandardAlgebraic -> Bool
$c== :: StandardAlgebraic -> StandardAlgebraic -> Bool
Eq, Int -> StandardAlgebraic -> ShowS
[StandardAlgebraic] -> ShowS
StandardAlgebraic -> String
(Int -> StandardAlgebraic -> ShowS)
-> (StandardAlgebraic -> String)
-> ([StandardAlgebraic] -> ShowS)
-> Show StandardAlgebraic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StandardAlgebraic] -> ShowS
$cshowList :: [StandardAlgebraic] -> ShowS
show :: StandardAlgebraic -> String
$cshow :: StandardAlgebraic -> String
showsPrec :: Int -> StandardAlgebraic -> ShowS
$cshowsPrec :: Int -> StandardAlgebraic -> ShowS
Show)

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

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

-- | Represent the specified /turn/ in SAN.
showsTurn
	:: ExplicitEnPassant
	-> Component.Turn.Turn
	-> Model.Game.Game	-- ^ The /game/ prior to application of the specified /turn/.
	-> ShowS
showsTurn :: Bool -> Turn -> Game -> ShowS
showsTurn Bool
explicitEnPassant Turn
turn Game
game
	| Just Rank
sourceRank <- Piece -> Rank
Component.Piece.getRank (Piece -> Rank) -> Maybe Piece -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybePieceByCoordinates -> Coordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference (Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board) Coordinates
source	= (
		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 -> [Coordinates] -> [Coordinates]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete Coordinates
source {-search for alternatives-} ([Coordinates] -> [Coordinates]) -> [Coordinates] -> [Coordinates]
forall a b. (a -> b) -> a -> b
$ Board -> Piece -> Coordinates -> [Coordinates]
State.Board.findAttacksBy Board
board (
						LogicalColour -> Rank -> Piece
Component.Piece.mkPiece (Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game) Rank
sourceRank
					) Coordinates
destination of
						[]		-> ShowS
forall a. a -> a
id	-- There're aren't any pieces of this rank which can perform this move.
						[Coordinates]
coordinates	-> case (Coordinates -> Bool) -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
							(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates -> Int
Cartesian.Coordinates.getX Coordinates
source) (Int -> Bool) -> (Coordinates -> Int) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Int
Cartesian.Coordinates.getX
						 ) ([Coordinates] -> Bool)
-> ([Coordinates] -> Bool) -> [Coordinates] -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Coordinates -> Bool) -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
							(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates -> Int
Cartesian.Coordinates.getY Coordinates
source) (Int -> Bool) -> (Coordinates -> Int) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Int
Cartesian.Coordinates.getY
						 ) ([Coordinates] -> (Bool, Bool)) -> [Coordinates] -> (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ [Coordinates]
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 -> Maybe LogicalColour
Model.Game.getMaybeChecked Game
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 -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason Game
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
. Notation -> Coordinates -> ShowS
Notation.Notation.showsCoordinates Notation
Notation.PureCoordinate.notation Coordinates
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 -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN Game
game String
"."
	where
		((Coordinates
source, Coordinates
destination), MoveType
moveType)	= (Move -> Coordinates
Component.Move.getSource (Move -> Coordinates)
-> (Move -> Coordinates) -> Move -> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move -> Coordinates
Component.Move.getDestination) (Move -> (Coordinates, Coordinates))
-> (QualifiedMove -> Move)
-> QualifiedMove
-> (Coordinates, Coordinates)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> (Coordinates, Coordinates))
-> (QualifiedMove -> MoveType)
-> QualifiedMove
-> ((Coordinates, Coordinates), MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> ((Coordinates, Coordinates), MoveType))
-> QualifiedMove -> ((Coordinates, Coordinates), MoveType)
forall a b. (a -> b) -> a -> b
$ Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
		board :: Board
board					= Game -> Board
Model.Game.getBoard Game
game

		isEnPassant, isCapture :: Bool
		isEnPassant :: Bool
isEnPassant	= MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType
		isCapture :: Bool
isCapture	= MaybePieceByCoordinates -> Coordinates -> Bool
State.MaybePieceByCoordinates.isOccupied (Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board) Coordinates
destination 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), ShowS
showsDestination)	= (Notation -> Coordinates -> (ShowS, ShowS)
`Notation.Notation.encode` Coordinates
source) (Notation -> (ShowS, ShowS))
-> (Notation -> ShowS) -> Notation -> ((ShowS, ShowS), ShowS)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Notation -> Coordinates -> ShowS
`Notation.Notation.showsCoordinates` Coordinates
destination) (Notation -> ((ShowS, ShowS), ShowS))
-> Notation -> ((ShowS, ShowS), ShowS)
forall a b. (a -> b) -> a -> b
$ Notation
Notation.PureCoordinate.notation

		game' :: Game
game'	= Turn -> Transformation
Model.Game.takeTurn Turn
turn Game
game

-- | Calls 'showsTurn'.
showTurn
	:: ExplicitEnPassant
	-> Component.Turn.Turn
	-> Model.Game.Game	-- ^ The /game/ prior to application of the specified /turn/.
	-> String
showTurn :: Bool -> Turn -> Game -> String
showTurn Bool
explicitEnPassant Turn
turn Game
game	= Bool -> Turn -> Game -> ShowS
showsTurn Bool
explicitEnPassant Turn
turn Game
game String
""

-- | A convenience-function, which generates the /turn/ required to call 'showsTurn'.
showsMove
	:: ExplicitEnPassant
	-> Component.QualifiedMove.QualifiedMove
	-> Model.Game.Game
	-> ShowS
showsMove :: Bool -> QualifiedMove -> Game -> ShowS
showsMove Bool
explicitEnPassant QualifiedMove
qualifiedMove Game
game	= Bool -> Turn -> Game -> ShowS
showsTurn Bool
explicitEnPassant (
	Turn -> Maybe Turn -> Turn
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
		Exception -> Turn
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn) -> Exception -> Turn
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.ContextualNotation.StandardAlgebraic.showsMove:\tModel.Game.maybeLastTurn failed."
	) (Maybe Turn -> Turn) -> (Game -> Maybe Turn) -> Game -> Turn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe Turn
Model.Game.maybeLastTurn (Game -> Turn) -> Game -> Turn
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> Transformation
Model.Game.applyQualifiedMove QualifiedMove
qualifiedMove Game
game
 ) Game
game

-- | Calls 'showsMove'.
showMove
	:: ExplicitEnPassant
	-> Component.QualifiedMove.QualifiedMove
	-> Model.Game.Game
	-> String
showMove :: Bool -> QualifiedMove -> Game -> String
showMove Bool
explicitEnPassant QualifiedMove
qualifiedMove Game
game	= Bool -> QualifiedMove -> Game -> ShowS
showsMove Bool
explicitEnPassant QualifiedMove
qualifiedMove Game
game String
""

-- | Applies the specified /move/ to the specified /game/.
movePiece :: StandardAlgebraic -> Model.Game.Transformation
movePiece :: StandardAlgebraic -> Transformation
movePiece MkStandardAlgebraic { getQualifiedMove :: StandardAlgebraic -> QualifiedMove
getQualifiedMove = QualifiedMove
qualifiedMove }	= QualifiedMove -> Transformation
Model.Game.applyQualifiedMove QualifiedMove
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
	:: ExplicitEnPassant
	-> ValidateMoves
	-> Model.Game.Game
#ifdef USE_POLYPARSE
	-> Text.Poly.TextParser StandardAlgebraic
parser :: Bool -> Bool -> Game -> TextParser StandardAlgebraic
parser Bool
explicitEnPassant Bool
validateMoves Game
game	= let
	nextLogicalColour :: LogicalColour
nextLogicalColour			= Game -> LogicalColour
Model.Game.getNextLogicalColour Game
game
	(CastlingMove
longCastlingMove, CastlingMove
shortCastlingMove)	= LogicalColour -> (CastlingMove, CastlingMove)
Component.CastlingMove.getLongAndShortMoves LogicalColour
nextLogicalColour
	board :: Board
board					= Game -> Board
Model.Game.getBoard Game
game
	getMaybePiece :: Coordinates -> Maybe Piece
getMaybePiece				= MaybePieceByCoordinates -> Coordinates -> Maybe Piece
State.MaybePieceByCoordinates.dereference (MaybePieceByCoordinates -> Coordinates -> Maybe Piece)
-> MaybePieceByCoordinates -> Coordinates -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ Board -> MaybePieceByCoordinates
State.Board.getMaybePieceByCoordinates Board
board
	getMaybeRank :: Coordinates -> 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 -> Maybe Piece) -> Coordinates -> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Maybe Piece
getMaybePiece
 in do
	QualifiedMove
qualifiedMove	<- TextParser ()
Text.Poly.spaces TextParser ()
-> Parser Char QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(String, Parser Char QualifiedMove)] -> Parser Char QualifiedMove
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 -> [Coordinates]
findAttacksBy Coordinates
destination	= Board -> Piece -> Coordinates -> [Coordinates]
State.Board.findAttacksBy Board
board Piece
piece Coordinates
destination

				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)] -> Parser Char QualifiedMove
forall (p :: * -> *) a. Commitment p => [(String, p a)] -> p a
Poly.oneOf' [
						(
							String
"Pawn-advance",
							do
								Coordinates
destination	<- TextParser Coordinates
Notation.PureCoordinate.coordinatesParser

								Parser Char QualifiedMove
-> (Coordinates -> Parser Char QualifiedMove)
-> Maybe Coordinates
-> Parser Char QualifiedMove
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
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char QualifiedMove)
-> ShowS -> String -> Parser Char QualifiedMove
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 -> ShowS
forall a. Show a => a -> ShowS
shows Coordinates
destination ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Before " (String -> Parser Char QualifiedMove)
-> String -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
context String
"."
								 ) (
									\Coordinates
source -> (
										Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination) (MoveType -> QualifiedMove)
-> (Maybe Rank -> MoveType) -> Maybe Rank -> QualifiedMove
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)
-> Parser Char (Maybe Rank) -> Parser Char QualifiedMove
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 -> Parser Char QualifiedMove)
-> ([Maybe Coordinates] -> Maybe Coordinates)
-> [Maybe Coordinates]
-> Parser Char QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates -> Bool) -> [Coordinates] -> Maybe Coordinates
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 -> Maybe Piece) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Maybe Piece
getMaybePiece
								 ) ([Coordinates] -> Maybe Coordinates)
-> ([Maybe Coordinates] -> [Coordinates])
-> [Maybe Coordinates]
-> Maybe Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Coordinates] -> [Coordinates]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes ([Maybe Coordinates] -> [Coordinates])
-> ([Maybe Coordinates] -> [Maybe Coordinates])
-> [Maybe Coordinates]
-> [Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Maybe Coordinates] -> [Maybe Coordinates]
forall a. Int -> [a] -> [a]
take Int
2 {-maximum Pawn-advance-} ([Maybe Coordinates] -> [Maybe Coordinates])
-> ([Maybe Coordinates] -> [Maybe Coordinates])
-> [Maybe Coordinates]
-> [Maybe Coordinates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Coordinates] -> [Maybe Coordinates]
forall a. [a] -> [a]
tail {-drop the original-} ([Maybe Coordinates] -> Parser Char QualifiedMove)
-> [Maybe Coordinates] -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ (Maybe Coordinates -> Maybe Coordinates)
-> Maybe Coordinates -> [Maybe Coordinates]
forall a. (a -> a) -> a -> [a]
iterate (
									Maybe Coordinates
-> (Coordinates -> Maybe Coordinates) -> Maybe Coordinates
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour -> Coordinates -> Maybe Coordinates
Cartesian.Coordinates.maybeRetreat LogicalColour
nextLogicalColour
								 ) (Maybe Coordinates -> [Maybe Coordinates])
-> Maybe Coordinates -> [Maybe Coordinates]
forall a b. (a -> b) -> a -> b
$ Coordinates -> Maybe Coordinates
forall a. a -> Maybe a
Just Coordinates
destination
						), (
							String
"Pawn-capture",
							do
								Int
x		<- TextParser Int
Notation.PureCoordinate.abscissaParser
								Char
_		<- Parser Char Char
captureParser
								Coordinates
destination	<- TextParser Coordinates -> TextParser Coordinates
forall (p :: * -> *) a. Commitment p => p a -> p a
Poly.commit TextParser Coordinates
Notation.PureCoordinate.coordinatesParser

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

								Parser Char QualifiedMove
-> (Coordinates -> Parser Char QualifiedMove)
-> Maybe Coordinates
-> Parser Char QualifiedMove
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
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char QualifiedMove)
-> ShowS -> String -> Parser Char QualifiedMove
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 -> ShowS
forall a. Show a => a -> ShowS
shows Coordinates
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
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". Before " (String -> Parser Char QualifiedMove)
-> String -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
context String
"."
								 ) (
									\Coordinates
source -> Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove (
										Coordinates -> Coordinates -> Move
Component.Move.mkMove Coordinates
source Coordinates
destination
									) (MoveType -> QualifiedMove)
-> Parser Char MoveType -> Parser Char QualifiedMove
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 -> Parser Char QualifiedMove)
-> ([Coordinates] -> Maybe Coordinates)
-> [Coordinates]
-> Parser Char QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates -> Bool) -> [Coordinates] -> Maybe Coordinates
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
									(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x) (Int -> Bool) -> (Coordinates -> Int) -> Coordinates -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> Int
Cartesian.Coordinates.getX
								 ) ([Coordinates] -> Parser Char QualifiedMove)
-> [Coordinates] -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Coordinates]
findAttacksBy Coordinates
destination
						)
					]
					else {-not a Pawn-} let
						mkNormalMoveType :: Coordinates -> MoveType
mkNormalMoveType Coordinates
destination	= Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType (Coordinates -> Maybe Rank
getMaybeRank Coordinates
destination) Maybe Rank
forall a. Maybe a
Nothing {-promotion-}

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

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

								Coordinates
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 -> TextParser Coordinates
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser Coordinates
Notation.PureCoordinate.coordinatesParser

								Coordinates -> [Coordinates] -> Parser Char QualifiedMove
resolveQualifiedMove Coordinates
destination ([Coordinates] -> Parser Char QualifiedMove)
-> ([Coordinates] -> [Coordinates])
-> [Coordinates]
-> Parser Char QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates] -> [Coordinates]
sourceFilter ([Coordinates] -> Parser Char QualifiedMove)
-> [Coordinates] -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Coordinates]
findAttacksBy Coordinates
destination
						), (
							String
"Unqualified move",	-- The most likely scenario, where the intended attacker is unambiguous.
							Parser Char QualifiedMove -> Parser Char QualifiedMove
forall (p :: * -> *) a. Commitment p => p a -> p a
Poly.commit (Parser Char QualifiedMove -> Parser Char QualifiedMove)
-> Parser Char QualifiedMove -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ do
								Coordinates
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 -> TextParser Coordinates
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser Coordinates
Notation.PureCoordinate.coordinatesParser

								Coordinates -> [Coordinates] -> Parser Char QualifiedMove
resolveQualifiedMove Coordinates
destination ([Coordinates] -> Parser Char QualifiedMove)
-> [Coordinates] -> Parser Char QualifiedMove
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Coordinates]
findAttacksBy Coordinates
destination
						)
					]
		), (
			String
"Long castle",
			String -> TextParser ()
Text.Poly.string String
longCastleToken TextParser ()
-> Parser Char QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (
				(Move -> MoveType -> QualifiedMove)
-> (Move, MoveType) -> QualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove ((Move, MoveType) -> QualifiedMove)
-> (Move, MoveType) -> QualifiedMove
forall a b. (a -> b) -> a -> b
$ (CastlingMove -> Move
Component.CastlingMove.getKingsMove (CastlingMove -> Move)
-> (CastlingMove -> MoveType) -> CastlingMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CastlingMove -> MoveType
Component.CastlingMove.getMoveType) CastlingMove
longCastlingMove
			)
		), (
			String
"Short castle",
			String -> TextParser ()
Text.Poly.string String
shortCastleToken TextParser ()
-> Parser Char QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} (
				(Move -> MoveType -> QualifiedMove)
-> (Move, MoveType) -> QualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> MoveType -> QualifiedMove
Component.QualifiedMove.mkQualifiedMove ((Move, MoveType) -> QualifiedMove)
-> (Move, MoveType) -> QualifiedMove
forall a b. (a -> b) -> a -> b
$ (CastlingMove -> Move
Component.CastlingMove.getKingsMove (CastlingMove -> Move)
-> (CastlingMove -> MoveType) -> CastlingMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CastlingMove -> MoveType
Component.CastlingMove.getMoveType) CastlingMove
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 -> StandardAlgebraic
fromQualifiedMove (QualifiedMove -> StandardAlgebraic)
-> Parser Char QualifiedMove -> TextParser StandardAlgebraic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (
		if Bool
validateMoves
			then Parser Char QualifiedMove
-> (String -> Parser Char QualifiedMove)
-> Maybe String
-> Parser Char QualifiedMove
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-} QualifiedMove
qualifiedMove) (String -> Parser Char QualifiedMove
forall (p :: * -> *) a. PolyParse p => String -> p a
Poly.failBad (String -> Parser Char QualifiedMove)
-> ShowS -> String -> Parser Char QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"failed: ") (Maybe String -> Parser Char QualifiedMove)
-> (QualifiedMove -> Maybe String)
-> QualifiedMove
-> Parser Char QualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> QualifiedMove -> Maybe String
Model.Game.validateQualifiedMove Game
game
			else QualifiedMove -> Parser Char QualifiedMove
forall (m :: * -> *) a. Monad m => a -> m a
return {-to Parser-monad-}
	 ) QualifiedMove
qualifiedMove
#else /* Parsec */
	-> Parsec.Parser StandardAlgebraic
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 board piece destination

			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	= \case
						[]			-> 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 game qualifiedMove
						 ] -- 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 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-}