{-# 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@]	Implements a parser for PGN-comments.
-}

module BishBosh.ContextualNotation.PGNComment(
-- * Types
-- ** Data-types
	PGNComment(..),
-- * Constants
--	blockCommentStart,
	blockCommentEnd,
--	lineCommentStart,
	lineCommentEnd,
-- * Functions
	blockCommentParser,
--	lineCommentParser,
	parser,
-- ** Accessors
	getString
) where

import			Control.Applicative((<|>))
import qualified	Control.Applicative

#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	Control.Monad
import qualified	Text.ParserCombinators.Parsec		as Parsec
import			Text.ParserCombinators.Parsec((<?>))
#endif

-- | Constant comment start-delimiter.
blockCommentStart :: Char
blockCommentStart :: Char
blockCommentStart	= Char
'{'

-- | Constant comment end-delimiter.
blockCommentEnd :: Char
blockCommentEnd :: Char
blockCommentEnd		= Char
'}'

-- | Constant comment end-delimiter.
lineCommentStart :: Char
lineCommentStart :: Char
lineCommentStart	= Char
';'

-- | Constant comment end-delimiter.
lineCommentEnd :: Char
lineCommentEnd :: Char
lineCommentEnd		= Char
'\n'

-- | Represents a comment in PGN.
data PGNComment	= BlockComment String | LineComment String

instance Show PGNComment where
	showsPrec :: Int -> PGNComment -> ShowS
showsPrec Int
_ (BlockComment String
s)	= Char -> ShowS
showChar Char
blockCommentStart ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
blockCommentEnd
	showsPrec Int
_ (LineComment String
s)	= Char -> ShowS
showChar Char
lineCommentStart ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
lineCommentEnd

-- | Accessor.
getString :: PGNComment -> String
getString :: PGNComment -> String
getString (BlockComment String
s)	= String
s
getString (LineComment String
s)	= String
s

-- | Parses PGN block-comments.
blockCommentParser ::
#ifdef USE_POLYPARSE
	Text.Poly.TextParser PGNComment
blockCommentParser :: TextParser PGNComment
blockCommentParser	= TextParser ()
Text.Poly.spaces TextParser () -> TextParser PGNComment -> TextParser PGNComment
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser ()
-> TextParser () -> TextParser PGNComment -> TextParser PGNComment
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
Poly.bracket (
	Char -> TextParser ()
Text.Poly.char Char
blockCommentStart
 ) (
	Char -> TextParser ()
Text.Poly.char Char
blockCommentEnd	-- CAVEAT: 'Poly.commit' here fails ?!
 ) (
	String -> PGNComment
BlockComment (String -> PGNComment)
-> Parser Char String -> TextParser PGNComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser Char Char -> Parser Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Control.Applicative.many ((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
blockCommentEnd) String
"Block-comment")
 )
#else /* Parsec */
	Parsec.Parser PGNComment
blockCommentParser	= Parsec.try (
	Parsec.spaces >> Parsec.between (
		Parsec.char blockCommentStart	<?> "Block-comment start"
	) (
		Parsec.char blockCommentEnd	<?> "Block-comment end"
	) (
		BlockComment `fmap` Control.Applicative.many (Parsec.satisfy (/= blockCommentEnd)) <?> "Block-comment text"
	) <?> "Block-comment"
 )
#endif

-- | Parses PGN line-comments.
lineCommentParser ::
#ifdef USE_POLYPARSE
	Text.Poly.TextParser PGNComment
lineCommentParser :: TextParser PGNComment
lineCommentParser	= TextParser ()
Text.Poly.spaces TextParser () -> TextParser PGNComment -> TextParser PGNComment
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser ()
-> TextParser () -> TextParser PGNComment -> TextParser PGNComment
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
Poly.bracket (
	Char -> TextParser ()
Text.Poly.char Char
lineCommentStart
 ) (
	TextParser () -> TextParser ()
forall (p :: * -> *) a. Commitment p => p a -> p a
Poly.commit (TextParser () -> TextParser ()) -> TextParser () -> TextParser ()
forall a b. (a -> b) -> a -> b
$ Char -> TextParser ()
Text.Poly.char Char
lineCommentEnd TextParser () -> TextParser () -> TextParser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ()
forall t. Parser t ()
Poly.eof
 ) (
	String -> PGNComment
LineComment (String -> PGNComment)
-> Parser Char String -> TextParser PGNComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser Char Char -> Parser Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Control.Applicative.many ((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
lineCommentEnd) String
"Line-comment text")
 )
#else /* Parsec */
	Parsec.Parser PGNComment
lineCommentParser	= Parsec.try (
	Parsec.spaces >> Parsec.between (
		Parsec.char lineCommentStart	<?> "Line-comment start"
	) (
		Control.Monad.void (Parsec.char lineCommentEnd <?> "EOLN") <|> (Parsec.eof <?> "EOF")
	) (
		LineComment `fmap` Control.Applicative.many (Parsec.satisfy (/= lineCommentEnd)) <?> "Line-comment text"
	) <?> "Line-comment"
 )
#endif

-- | Parses PGN-comments.
parser ::
#ifdef USE_POLYPARSE
	Text.Poly.TextParser String
#else /* Parsec */
	Parsec.Parser String
#endif
parser :: Parser Char String
parser	= (PGNComment -> String)
-> TextParser PGNComment -> Parser Char String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PGNComment -> String
getString (TextParser PGNComment -> Parser Char String)
-> TextParser PGNComment -> Parser Char String
forall a b. (a -> b) -> a -> b
$ TextParser PGNComment
blockCommentParser TextParser PGNComment
-> TextParser PGNComment -> TextParser PGNComment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser PGNComment
lineCommentParser