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

	This file is part of BishBosh.

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

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

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

 [@DESCRIPTION@]	Defines a parser for PGN; <https://www.chessclub.com/user/help/pgn-spec>.
-}

module BishBosh.ContextualNotation.PGN(
-- * Types
-- ** Type-synonyms
	Tag,
--	Value,
--	TagPair,
	IsStrictlySequential,
-- ** Data-types
	PGN(
--		MkPGN,
--		getMaybeEventName,
--		getMaybeSiteName,
--		getDay,
		getMaybeRoundName,
--		getMaybeWhitePlayerName,
--		getMaybeBlackPlayerName,
		getIdentificationTagPairs,
		getGame
	),
-- * Constants
--	tagPairDelimiters,
--	ravDelimiters,
--	inProgressFlag,
--	moveNumberTerminator,
	quoteDelimiter,
--	dateComponentSeparator,
	unknownTagValue,
--	eventNameTag,
--	siteNameTag,
	dateTag,
--	roundNameTag,
--	whitePlayerNameTag,
--	blackPlayerNameTag,
--	resultTag,
-- * Functions
	showsDate,
	showsMoveText,
	showsGame,
--	nagParser,
--	moveNumberParser,
--	maybeResultParser,
	moveTextParser,
	parser,
-- ** Constructors
	mkPGN,
	mkPGN',
-- ** Mutators
	setGame
 ) where

import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour
import qualified	BishBosh.Component.Move				as Component.Move
import qualified	BishBosh.ContextualNotation.PGNComment		as ContextualNotation.PGNComment
import qualified	BishBosh.ContextualNotation.StandardAlgebraic	as ContextualNotation.StandardAlgebraic
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Model.Game				as Model.Game
import qualified	BishBosh.Model.GameTerminationReason		as Model.GameTerminationReason
import qualified	BishBosh.Model.Result				as Model.Result
import qualified	BishBosh.State.TurnsByLogicalColour		as State.TurnsByLogicalColour
import qualified	BishBosh.Text.ShowList				as Text.ShowList
import qualified	BishBosh.Types					as T
import qualified	Control.Applicative
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Char
import qualified	Data.Default
import qualified	Data.List
import qualified	Data.Map
import qualified	Data.Maybe
import qualified	Data.Time.Calendar
import qualified	Data.Time.Clock
import qualified	Text.Printf

#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	BishBosh.Data.Integral				as Data.Integral
import qualified	Text.ParserCombinators.Parsec			as Parsec
import			Text.ParserCombinators.Parsec((<?>), (<|>))
#endif

-- | The constant delimiters for a /tag-pair/.
tagPairDelimiters :: (Char, Char)
tagPairDelimiters	= ('[', ']')

-- | The constant delimiters for a /Recursive Annotation Variation/.
ravDelimiters :: (Char, Char)
ravDelimiters		= ('(', ')')

-- | Constant indication of a game still in progress.
inProgressFlag :: Char
inProgressFlag		= '*'

-- | Constant prefix for a /Numeric Annotation Glyph/.
nagPrefix :: Char
nagPrefix		= '$'

-- | Constant terminator for a move-number.
moveNumberTerminator :: Char
moveNumberTerminator	= '.'

-- | Constant delimiter for a tag-value.
quoteDelimiter :: Char
quoteDelimiter		= '"'

-- | Constant separator between the components of a date.
dateComponentSeparator :: Char
dateComponentSeparator	= '.'

-- | Constant used to represent an unknown value for a mandatory tag.
unknownTagValue :: Char
unknownTagValue		= '?'

-- | The type of the name of field in a PGN-specification.
type Tag	= String

-- | The type of the value of field in a PGN-specification.
type Value	= String

-- | Self-documentation.
type TagPair	= (Tag, Value)

-- | Whether moves with an unexpected number should be considered to be an error.
type IsStrictlySequential	= Bool

-- | Qualifies a mandatory tag-value.
eventNameTag :: Tag
eventNameTag		= "Event"

-- | Qualifies a mandatory tag-value.
siteNameTag :: Tag
siteNameTag		= "Site"

-- | Qualifies a mandatory tag-value.
dateTag :: Tag
dateTag			= "Date"

-- | Qualifies a tag-value.
roundNameTag :: Tag
roundNameTag		= "Round"

-- | Qualifies a mandatory tag-value.
whitePlayerNameTag :: Tag
whitePlayerNameTag	= "White"

-- | Qualifies a mandatory tag-value.
blackPlayerNameTag :: Tag
blackPlayerNameTag	= "Black"

-- | Qualifies a tag-value.
resultTag :: Tag
resultTag		= "Result"

-- | Shows the specified date in double quotes.
showsDate :: Data.Time.Calendar.Day -> ShowS
showsDate	= (
	\(y, m, d) -> shows (Text.Printf.printf "%04d.%02d.%02d" y m d :: String)
 ) . Data.Time.Calendar.toGregorian

{- |
	* The data defined by PGN.

	* The first six fields are mandatory part according to the PGN-specification, though none are used by this application.
	The seventh mandatory field 'Result' can be derived from 'getGame'.
-}
data PGN x y	= MkPGN {
	getMaybeEventName		:: Maybe Value,
	getMaybeSiteName		:: Maybe Value,
	getDay				:: Data.Time.Calendar.Day,
	getMaybeRoundName		:: Maybe Value,		-- ^ The name of the round; typically dotted decimal.
	getMaybeWhitePlayerName		:: Maybe Value,
	getMaybeBlackPlayerName		:: Maybe Value,
	getIdentificationTagPairs	:: [TagPair],		-- ^ Arbitrary tagged values.
	getGame				:: Model.Game.Game x y	-- ^ Defines the turn-sequence & the result.
} deriving Eq

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Show (PGN x y) where
	{-# SPECIALISE instance Show (PGN T.X T.Y) #-}
	showsPrec _ MkPGN {
		getMaybeEventName		= maybeEventName,
		getMaybeSiteName		= maybeSiteName,
		getDay				= day,
		getMaybeRoundName		= maybeRoundName,
		getMaybeWhitePlayerName		= maybeWhitePlayerName,
		getMaybeBlackPlayerName		= maybeBlackPlayerName,
		getIdentificationTagPairs	= identificationTagPairs,
		getGame				= game
	} = foldr (
		\(tagName, showsTagValue) accum -> showChar (fst tagPairDelimiters) . showString tagName . showChar ' ' . showsTagValue . showChar (snd tagPairDelimiters) . showChar '\n' . accum
	 ) (
		showsMoveText game . showChar '\n'
	 ) $ [
		(
			eventNameTag,		representUnknownTagValue maybeEventName
		), (
			siteNameTag,		representUnknownTagValue maybeSiteName
		), (
			dateTag,		showsDate day
		), (
			roundNameTag,		representUnknownTagValue maybeRoundName
		), (
			whitePlayerNameTag,	representUnknownTagValue maybeWhitePlayerName
		), (
			blackPlayerNameTag,	representUnknownTagValue maybeBlackPlayerName
		), (
			resultTag,		quote . Data.Maybe.maybe (showChar inProgressFlag) (shows . Model.GameTerminationReason.toResult) $ Model.Game.getMaybeTerminationReason game
		)
	 ] ++ map (
		Control.Arrow.second $ quote . showString
	 ) identificationTagPairs where
		quote :: ShowS -> ShowS
		quote s	= showChar quoteDelimiter . s . showChar quoteDelimiter

		representUnknownTagValue :: Maybe Value -> ShowS
		representUnknownTagValue	= quote . Data.Maybe.maybe (showChar unknownTagValue) showString

instance (
	Control.DeepSeq.NFData	x,
	Control.DeepSeq.NFData	y
 ) => Control.DeepSeq.NFData (PGN x y) where
	rnf MkPGN {
		getIdentificationTagPairs	= identificationTagPairs,
		getGame				= game
	} = Control.DeepSeq.rnf (identificationTagPairs, game)	-- CAVEAT: treat other fields lazily, since though they're specified as mandatory, this is isn't observed in practice because they're not typically required.

-- | Smart constructor.
mkPGN
	:: Maybe Value	-- ^ Event-name.
	-> Maybe Value	-- ^ Site-name.
	-> Data.Time.Calendar.Day
	-> Maybe Value	-- ^ Round.
	-> Maybe Value	-- ^ Name of White player.
	-> Maybe Value	-- ^ Name of Black player.
	-> [TagPair]	-- ^ Arbitrary tag-pairs.
	-> Model.Game.Game x y
	-> PGN x y
mkPGN maybeEventName maybeSiteName day maybeRoundName maybeWhitePlayerName maybeBlackPlayerName identificationTagPairs game
	| any (
		(== [unknownTagValue]) . snd {-tag-value-}
	) explicitTags	= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.ContextualNotation.PGN.mkPGN:\tunknownTagValue" . Text.ShowList.showsAssociation . shows unknownTagValue . showString " used literally; " $ show explicitTags
	| otherwise	= MkPGN {
		getMaybeEventName		= maybeEventName,
		getMaybeSiteName		= maybeSiteName,
		getDay				= day,
		getMaybeRoundName		= maybeRoundName,
		getMaybeWhitePlayerName		= maybeWhitePlayerName,
		getMaybeBlackPlayerName		= maybeBlackPlayerName,
		getIdentificationTagPairs	= identificationTagPairs,
		getGame				= game
	}
	where
		explicitTags	= [
			(tag, value) |
				(tag, Just value)	<- [
					(
						eventNameTag,		maybeEventName
					), (
						siteNameTag,		maybeSiteName
					), (
						whitePlayerNameTag,	maybeWhitePlayerName
					), (
						blackPlayerNameTag,	maybeBlackPlayerName
					)
				 ] -- Those tags for which an unknown value is represented by 'unknownTagValue'.
		 ] -- List-comprehension.

-- | Mutator.
setGame :: Model.Game.Game x y -> PGN x y -> PGN x y
setGame game pgn	= pgn { getGame = game }

-- | Smart-constructor.
mkPGN'
	:: [Tag]	-- ^ Identify fields used to form a unique composite game-identifier.
	-> [TagPair]	-- ^ The data from which to extract the required values.
	-> Model.Game.Game x y
	-> PGN x y
mkPGN' identificationTags tagPairs	= mkPGN maybeEventName maybeSiteName (
	let
#ifdef USE_POLYPARSE
		dateParser :: Text.Poly.TextParser Data.Time.Calendar.Day
		dateParser	= do
			[y, m, d]	<- Text.Poly.spaces >> Poly.sepBy1 Text.Poly.unsignedDecimal (Text.Poly.char dateComponentSeparator)

			return {-to Parser-monad-} $ Data.Time.Calendar.fromGregorian (fromIntegral y) m d
	in Data.Maybe.maybe (
		Control.Exception.throw . Data.Exception.mkSearchFailure . showString "failed to find " $ show dateTag	-- N.B.: this will only terminate the application when the date is evaluated.
	) (
#if USE_POLYPARSE != 1
		either (
			Control.Exception.throw . Data.Exception.mkParseFailure . showString "failed to parse " . shows dateTag . showString "; " . show
		) id .
#endif
		fst . Poly.runParser dateParser
#else /* Parsec */
		dateParser :: Parsec.Parser Data.Time.Calendar.Day
		dateParser	= do
			[y, m, d]	<- Parsec.spaces >> (Parsec.sepBy1 (Control.Applicative.some Parsec.digit) (Parsec.char dateComponentSeparator)	<?> "YYYY.MM.DD")

			return {-to ParsecT-monad-} $ Data.Time.Calendar.fromGregorian (read y) (read m) (read d)
	in Data.Maybe.maybe (
		Control.Exception.throw . Data.Exception.mkSearchFailure . showString "failed to find " $ show dateTag	-- N.B.: this will only terminate the application when the date is evaluated.
	) (
		either (
			Control.Exception.throw . Data.Exception.mkParseFailure . showString "failed to parse " . shows dateTag . showString "; " . show
		) id . Parsec.parse dateParser "Date-parser"
#endif
	) maybeDate
 ) maybeRoundName maybeWhitePlayerName maybeBlackPlayerName $ filter (
	(`elem` identificationTags) . fst {-tag-}
 ) tagPairs where
	[maybeEventName, maybeSiteName, maybeDate, maybeRoundName, maybeWhitePlayerName, maybeBlackPlayerName]	= map (
		`Data.Map.lookup` Data.Map.fromList tagPairs
	 ) [
		eventNameTag,
		siteNameTag,
		dateTag,
		roundNameTag,
		whitePlayerNameTag,
		blackPlayerNameTag
	 ]

{- |
	* Represents the specified /game/ in /Portable Game Notation/; <https://www.chessclub.com/user/help/pgn-spec>.

	* This function is only responsible for the line defining the numbered sequence of /move/s represented in SAN.
-}
showsMoveText :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Model.Game.Game x y -> ShowS
{-# SPECIALISE showsMoveText :: Model.Game.Game T.X T.Y -> ShowS #-}
showsMoveText game	= foldr (.) (
	Data.Maybe.maybe (
		showsBlockComment "Game unfinished" . showChar ' ' . showChar inProgressFlag
	) (
		(
			\(s, showsPGN) -> showsBlockComment s . showChar ' ' . showsPGN
		) . (
			filter (/= ContextualNotation.PGNComment.blockCommentEnd) . show &&& shows . Model.GameTerminationReason.toResult
		)
	) $ Model.Game.getMaybeTerminationReason game
 ) $ Data.List.unfoldr (
	\(moveNumber, turns) -> case turns of
		showsWhiteMove : remainder	-> Just . (
			(
				\moveList -> shows moveNumber . showChar moveNumberTerminator . showChar ' ' . showsWhiteMove . Data.Maybe.maybe id (
					\showsBlackMove -> showChar ' ' . showsBlackMove
				) (
					Data.Maybe.listToMaybe moveList
				) . showChar ' '	-- Show an element.
			) *** (,) (succ moveNumber)
		 ) $ Data.List.splitAt 1 remainder
		_				-> Nothing
 ) (
	1	:: Component.Move.NMoves,
	reverse {-chronological-} $ fst . foldr (
		\turn (l, game')	-> (
			ContextualNotation.StandardAlgebraic.showsTurn False turn game' : l,
			Model.Game.takeTurn turn game'
		) -- Pair.
	) ([], Data.Default.def {-game-}) $ Model.Game.listTurns game
 ) where
	showsBlockComment :: String -> ShowS
	showsBlockComment	= shows . ContextualNotation.PGNComment.BlockComment

-- | Shows PGN for the specified /game/, with defaults for other fields.
showsGame :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => Model.Game.Game x y -> IO ShowS
{-# SPECIALISE showsGame :: Model.Game.Game T.X T.Y -> IO ShowS #-}
showsGame game	= do
	utcTime	<- Data.Time.Clock.getCurrentTime

	return {-to IO-monad-} . shows $ mkPGN Nothing Nothing (Data.Time.Clock.utctDay utcTime) Nothing Nothing Nothing [] game

-- | Parse a /Numeric Annotation Glyph/.
nagParser :: (
	Num	i,
	Ord	i,
	Show	i
 ) =>
#ifdef USE_POLYPARSE
	Text.Poly.TextParser i
nagParser	= do
	code	<- Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces >> Text.Poly.char nagPrefix >> Text.Poly.unsignedDecimal

	if code > maxCode
		then Poly.failBad . shows code . showString " > maximum NAG" . Text.ShowList.showsAssociation $ shows maxCode "."
		else return {-to Parser-monad-} code
#else /* Parsec */
	Parsec.Parser i
nagParser	= Parsec.try $ do
	code	<- Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> Parsec.char nagPrefix >> fmap Data.Integral.stringToUnsignedDecimal (Control.Applicative.some Parsec.digit)

	if code > maxCode
		then fail . shows code . showString " > maximum NAG" . Text.ShowList.showsAssociation $ shows maxCode "."
		else return {-to ParsecT-monad-} code
#endif
	where
		maxCode	= 255

{- |
	* Parses a move-number.

	* N.B.: officially terminated by a single period (for White), or three (by Black); though this parser is more flexible.
-}
moveNumberParser :: Num n =>
#ifdef USE_POLYPARSE
	Text.Poly.TextParser n
moveNumberParser	= Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.unsignedDecimal `Poly.discard` Control.Applicative.some (Text.Poly.char moveNumberTerminator)
#else /* Parsec */
	Parsec.Parser n
moveNumberParser	= Parsec.try $ Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> fmap Data.Integral.stringToUnsignedDecimal (
	Parsec.manyTill Parsec.digit (
		Control.Applicative.some $ Parsec.char moveNumberTerminator
	) <?> "Move-number"
 )
#endif

-- | Parse an optional result.
maybeResultParser ::
#ifdef USE_POLYPARSE
	Text.Poly.TextParser (Maybe Model.Result.Result)
maybeResultParser	= Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces >> Poly.oneOf' [
	(
		"Result",
		Poly.oneOf $ map (
			\result -> Text.Poly.string (show result) >> return {-to Parser-monad-} (Just result)	-- CAVEAT: for some reason, this conflates "1-0" with "1/2-1/2", when lazy-parsing with ghc-8.0.1 & polyparse-1.12 ?!
		) Model.Result.range
	), (
		"Game unfinished",
		Poly.commit (Text.Poly.char inProgressFlag) >> return {-to Parser-monad-} Nothing
	)
 ]
#else /* Parsec */
	Parsec.Parser (Maybe Model.Result.Result)
maybeResultParser	= Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> (
	Parsec.try (
		Parsec.choice $ map (
			\result -> Parsec.try $ (Parsec.string (show result) <?> "Result") >> return {-to ParsecT-monad-} (Just result)
		) Model.Result.range
	) <|> (
		(Parsec.char inProgressFlag <?> "Game unfinished") >> return {-to ParsecT-monad-} Nothing
	)
 )
#endif

-- | Parses a /game/ from PGN move-text.
moveTextParser :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
#ifdef USE_POLYPARSE
	=> IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> Text.Poly.TextParser (Model.Game.Game x y)
{-# SPECIALISE moveTextParser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> Text.Poly.TextParser (Model.Game.Game T.X T.Y) #-}
moveTextParser isStrictlySequential validateMoves	= let
	elementSequenceParser :: (
		Enum	x,
		Enum	y,
		Ord	x,
		Ord	y,
		Show	x,
		Show	y
	 ) => Model.Game.Game x y -> Text.Poly.TextParser (Model.Game.Game x y)
	elementSequenceParser game	= let
		expectedMoveNumber	= succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game
	 in do
		moveNumber	<- (
			if Attribute.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game
				then fmap (Data.Maybe.fromMaybe expectedMoveNumber) . Control.Applicative.optional
				else id
		 ) moveNumberParser

		if isStrictlySequential && moveNumber /= expectedMoveNumber
			then do
				context	<- Poly.manyFinally' Poly.next $ Text.Poly.char '\n'

				Poly.failBad . showString "found " . shows (Model.Game.getNextLogicalColour game) . showString " move-number" . Text.ShowList.showsAssociation . shows moveNumber . showString " where " . shows expectedMoveNumber . showString " expected, before " $ shows context "."
			else do
				game'	<- fmap (`ContextualNotation.StandardAlgebraic.movePiece` game) $ Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> ContextualNotation.StandardAlgebraic.parser False {-explicitEnPassant-} validateMoves game

				Control.Applicative.many (
					nagParser :: Text.Poly.TextParser Int
				 ) >> Control.Applicative.many (
					uncurry Poly.bracket (
						(
							\c -> Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces >> Text.Poly.char c
						) *** (
							\c -> Poly.commit $ Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces >> Text.Poly.char c
						) $ ravDelimiters
					) $ elementSequenceParser game {-recurse-}
				 ) >> fmap (Data.Maybe.fromMaybe game') (
					Control.Applicative.optional $ elementSequenceParser game' {-recurse-}
				 )
 in do
	game	<- fmap (Data.Maybe.fromMaybe Data.Default.def {-game-}) . Control.Applicative.optional $ elementSequenceParser Data.Default.def {-game-}
#else /* Parsec */
	=> IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> Parsec.Parser (Model.Game.Game x y)
{-# SPECIALISE moveTextParser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> Parsec.Parser (Model.Game.Game T.X T.Y) #-}
moveTextParser isStrictlySequential validateMoves	= let
	elementSequenceParser :: (
		Enum	x,
		Enum	y,
		Ord	x,
		Ord	y,
		Show	x,
		Show	y
	 ) => Model.Game.Game x y -> Parsec.Parser (Model.Game.Game x y)
	elementSequenceParser game	= let
		expectedMoveNumber	= succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game
	 in do
		moveNumber	<- (
			if Attribute.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game
				then fmap (Data.Maybe.fromMaybe expectedMoveNumber) . Control.Applicative.optional
				else id
		 ) moveNumberParser

		if isStrictlySequential && moveNumber /= expectedMoveNumber
			then fail . showString "found " . shows (Model.Game.getNextLogicalColour game) . showString " move-number" . Text.ShowList.showsAssociation . shows moveNumber . showString " where " $ shows expectedMoveNumber " expected."
			else do
				game'	<- (`ContextualNotation.StandardAlgebraic.movePiece` game) <$> (Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> ContextualNotation.StandardAlgebraic.parser False {-explicitEnPassant-} validateMoves game)

				Control.Applicative.many (
					nagParser :: Parsec.Parser Int
				 ) >> Control.Applicative.many (
					Parsec.try . uncurry Parsec.between (
						(
							\c -> Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> Parsec.char c
						) *** (
							\c -> Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> Parsec.char c
						) $ ravDelimiters
					) $ elementSequenceParser game {-recurse-}
				 ) >> Parsec.option game' (
					Parsec.try $ elementSequenceParser game' {-recurse-}
				 )
 in do
	game	<- Parsec.option Data.Default.def {-game-} . Parsec.try $ elementSequenceParser Data.Default.def {-game-}
#endif
	Data.Maybe.maybe game (`Model.Game.updateTerminationReasonWith` game) `fmap` maybeResultParser

{- |
	* Parses /PGN/.

	* CAVEAT: this process is inherently strict when using either "Parsec" or "Poly.Plain", since on failure they returns @Left@, which can't be determined until parsing has finished.
-}
parser :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> [Tag]	-- ^ Identify fields used to form a unique composite game-identifier.
#ifdef USE_POLYPARSE
	-> Text.Poly.TextParser (PGN x y)
{-# SPECIALISE parser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [Tag] -> Text.Poly.TextParser (PGN T.X T.Y) #-}
parser isStrictlySequential validateMoves identificationTags	= do
	tagPairs	<- Control.Applicative.many $ tagPairParser <* Control.Applicative.many ContextualNotation.PGNComment.parser
	moveText	<- moveTextParser' <* Control.Applicative.many ContextualNotation.PGNComment.parser

	return {-to Parser-monad-} $ mkPGN' identificationTags (removeUnknownTagValues tagPairs) moveText

	where
		tagPairParser :: Text.Poly.TextParser TagPair
		tagPairParser	= Control.Applicative.many ContextualNotation.PGNComment.parser >> Text.Poly.spaces >> uncurry Poly.bracket (
			Text.Poly.char *** Poly.commit . Text.Poly.char $ tagPairDelimiters
		 ) (
			do
				tagName		<- Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces >> Poly.commit (Control.Applicative.some $ Poly.satisfyMsg isValidTagCharacter "Tag-name")
				tagValue	<- Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces >> Poly.bracket (
					Text.Poly.char quoteDelimiter
				 ) (
					Poly.commit $ Text.Poly.char quoteDelimiter
				 ) (
					Control.Applicative.many $ Poly.satisfyMsg (/= quoteDelimiter) "Tag-value"	-- TODO: must account for escaped quotes.
				 )

				Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Text.Poly.spaces

				return {-to Parser-monad-} (tagName, tagValue)
		 )
#else /* Parsec */
	-> Parsec.Parser (PGN x y)
{-# SPECIALISE parser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [Tag] -> Parsec.Parser (PGN T.X T.Y) #-}
parser isStrictlySequential validateMoves identificationTags	= mkPGN' identificationTags <$> (
	removeUnknownTagValues <$> Control.Applicative.many (
		tagPairParser <* Control.Applicative.many ContextualNotation.PGNComment.parser
	)
 ) <*> moveTextParser' <* Control.Applicative.many ContextualNotation.PGNComment.parser
	where
		tagPairParser :: Parsec.Parser TagPair
		tagPairParser	= Parsec.try $ Control.Applicative.many ContextualNotation.PGNComment.parser >> Parsec.spaces >> uncurry Parsec.between (
			Parsec.char *** Parsec.char $ tagPairDelimiters
		 ) (
			do
				tagName		<- Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> (Control.Applicative.some (Parsec.satisfy isValidTagCharacter) <?> "Tag-name")
				tagValue	<- Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces >> Parsec.between (
					Parsec.char quoteDelimiter
				 ) (
					Parsec.char quoteDelimiter
				 ) (
					Control.Applicative.many (Parsec.satisfy (/= quoteDelimiter))	<?> "Tag-value"	-- TODO: must account for escaped quotes.
				 )

				Control.Applicative.many ContextualNotation.PGNComment.blockCommentParser >> Parsec.spaces

				return {-to ParsecT-monad-} (tagName, tagValue)
		 )
#endif
		moveTextParser'	= moveTextParser isStrictlySequential validateMoves

		isValidTagCharacter :: Char -> Bool
		isValidTagCharacter	= uncurry (&&) . (not . Data.Char.isSpace &&& (/= quoteDelimiter))

		removeUnknownTagValues :: [TagPair] -> [TagPair]
		removeUnknownTagValues	= filter ((/= [unknownTagValue]) . snd {-tag-value-})