{-# 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@]

	* Parses an optionally compressed file containing games encoded in PGN.

	* The parsed games can optionally be validated.

	* Permits the games to be filtered & their number capped.
-}

module BishBosh.ContextualNotation.PGNDatabase(
-- * Types
-- ** Type-synonyms
	PGNDatabase,
--	PGNPredicate,
	Decompressor,
	MaybeMaximumGames,
-- * Functions
--	parser,
--	parse,
	parseIO
 ) where

import			Control.DeepSeq(($!!))
import qualified	BishBosh.ContextualNotation.PGN			as ContextualNotation.PGN
import qualified	BishBosh.ContextualNotation.StandardAlgebraic	as ContextualNotation.StandardAlgebraic
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	BishBosh.Type.Length				as Type.Length
import qualified	Control.Exception
import qualified	Control.Monad
import qualified	Data.Maybe
import qualified	System.Exit
import qualified	System.FilePath
import qualified	System.IO
import qualified	System.Process

#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	Control.Arrow
import qualified	Text.ParserCombinators.Poly.Plain		as Poly
#	endif
#else /* Parsec */
import qualified	Control.Arrow
import qualified	Text.ParserCombinators.Parsec			as Parsec
import			Text.ParserCombinators.Parsec((<?>))
#endif

-- | Self-documentation.
type PGNDatabase x y	= [ContextualNotation.PGN.PGN x y]

-- | Parse a PGN-database.
parser :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> ContextualNotation.PGN.IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> [ContextualNotation.PGN.Tag]
#ifdef USE_POLYPARSE
	-> Text.Poly.TextParser (PGNDatabase x y)
{-# SPECIALISE parser :: ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [ContextualNotation.PGN.Tag] -> Text.Poly.TextParser (PGNDatabase Type.Length.X Type.Length.Y) #-}
parser :: IsStrictlySequential
-> IsStrictlySequential -> [Tag] -> TextParser (PGNDatabase x y)
parser IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves [Tag]
identificationTags	= Parser Char (PGN x y)
-> Parser Char () -> TextParser (PGNDatabase x y)
forall (p :: * -> *) a z.
(PolyParse p, Show a) =>
p a -> p z -> p [a]
Poly.manyFinally' Parser Char (PGN x y)
parser' (Parser Char () -> TextParser (PGNDatabase x y))
-> Parser Char () -> TextParser (PGNDatabase x y)
forall a b. (a -> b) -> a -> b
$ Parser Char ()
Text.Poly.spaces Parser Char () -> Parser Char () -> Parser Char ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char ()
forall t. Parser t ()
Poly.eof
#else /* Parsec */
	-> Parsec.Parser (PGNDatabase x y)
{-# SPECIALISE parser :: ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [ContextualNotation.PGN.Tag] -> Parsec.Parser (PGNDatabase Type.Length.X Type.Length.Y) #-}
parser isStrictlySequential validateMoves identificationTags	= Parsec.manyTill parser' (Parsec.try $ Parsec.spaces >> Parsec.try Parsec.eof)	<?> "PGN-database"
#endif
	where
		parser' :: Parser Char (PGN x y)
parser'	= IsStrictlySequential
-> IsStrictlySequential -> [Tag] -> Parser Char (PGN x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
IsStrictlySequential
-> IsStrictlySequential -> [Tag] -> TextParser (PGN x y)
ContextualNotation.PGN.parser IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves [Tag]
identificationTags

-- | PGNPredicate used to filter the database.
type PGNPredicate x y	= ContextualNotation.PGN.PGN x y -> Bool

-- | The optional maximum number of games to read.
type MaybeMaximumGames	= Maybe Type.Count.NGames

-- | Parses a PGN-database from the specified string.
parse :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> String		-- ^ The name of the specified database.
	-> ContextualNotation.PGN.IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> [ContextualNotation.PGN.Tag]
	-> PGNPredicate x y	-- ^ Used to filter entries from the database.
	-> MaybeMaximumGames	-- ^ Optional maximum number of games to read from the database (after they've been filtered).
	-> String		-- ^ The database-contents.
	-> Either String (PGNDatabase x y)
{-# SPECIALISE parse :: String -> ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [ContextualNotation.PGN.Tag] -> PGNPredicate Type.Length.X Type.Length.Y -> MaybeMaximumGames -> String -> Either String (PGNDatabase Type.Length.X Type.Length.Y) #-}
#ifdef USE_POLYPARSE
#	if USE_POLYPARSE == 1
parse _ isStrictlySequential validateMoves identificationTags pgnPredicate maybeMaximumGames	= Right	-- N.B.: the lazy parser throws an exception rather than returning 'Either', because otherwise it can't choose whether to construct with 'Left' or 'Right' until the input has been fully parsed.
#	else /* Plain */
parse :: Tag
-> IsStrictlySequential
-> IsStrictlySequential
-> [Tag]
-> PGNPredicate x y
-> MaybeMaximumGames
-> Tag
-> Either Tag (PGNDatabase x y)
parse Tag
name IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves [Tag]
identificationTags PGNPredicate x y
pgnPredicate MaybeMaximumGames
maybeMaximumGames	= (Tag -> Tag)
-> Either Tag (PGNDatabase x y) -> Either Tag (PGNDatabase x y)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
Control.Arrow.left (Tag -> Tag -> Tag
showString Tag
"regarding " (Tag -> Tag) -> (Tag -> Tag) -> Tag -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Tag -> Tag
forall a. Show a => a -> Tag -> Tag
shows Tag
name (Tag -> Tag) -> (Tag -> Tag) -> Tag -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Tag -> Tag
showString Tag
", ")
#	endif
	(Either Tag (PGNDatabase x y) -> Either Tag (PGNDatabase x y))
-> (Tag -> Either Tag (PGNDatabase x y))
-> Tag
-> Either Tag (PGNDatabase x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Tag (PGNDatabase x y), Tag) -> Either Tag (PGNDatabase x y)
forall a b. (a, b) -> a
fst {-discard unparsed data-} ((Either Tag (PGNDatabase x y), Tag)
 -> Either Tag (PGNDatabase x y))
-> (Tag -> (Either Tag (PGNDatabase x y), Tag))
-> Tag
-> Either Tag (PGNDatabase x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Char (PGNDatabase x y)
-> Tag -> (Either Tag (PGNDatabase x y), Tag)
forall t a. Parser t a -> [t] -> (Either Tag a, [t])
Poly.runParser Parser Char (PGNDatabase x y)
parser'
#else /* Parsec */
parse name isStrictlySequential validateMoves identificationTags pgnPredicate maybeMaximumGames	= Control.Arrow.left (showString "failed to parse; " . show) . Parsec.parse parser' name
#endif
	where
		parser' :: Parser Char (PGNDatabase x y)
parser'	= (
			(PGNDatabase x y -> PGNDatabase x y)
-> (NGames -> PGNDatabase x y -> PGNDatabase x y)
-> MaybeMaximumGames
-> PGNDatabase x y
-> PGNDatabase x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe PGNDatabase x y -> PGNDatabase x y
forall a. a -> a
id (NGames -> PGNDatabase x y -> PGNDatabase x y
forall a. NGames -> [a] -> [a]
take (NGames -> PGNDatabase x y -> PGNDatabase x y)
-> (NGames -> NGames)
-> NGames
-> PGNDatabase x y
-> PGNDatabase x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NGames -> NGames
forall a b. (Integral a, Num b) => a -> b
fromIntegral) MaybeMaximumGames
maybeMaximumGames (PGNDatabase x y -> PGNDatabase x y)
-> (PGNDatabase x y -> PGNDatabase x y)
-> PGNDatabase x y
-> PGNDatabase x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGNPredicate x y -> PGNDatabase x y -> PGNDatabase x y
forall a. (a -> IsStrictlySequential) -> [a] -> [a]
filter PGNPredicate x y
pgnPredicate	-- CAVEAT: apply the filter before extracting the required number of games.
		 ) (PGNDatabase x y -> PGNDatabase x y)
-> Parser Char (PGNDatabase x y) -> Parser Char (PGNDatabase x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IsStrictlySequential
-> IsStrictlySequential -> [Tag] -> Parser Char (PGNDatabase x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
IsStrictlySequential
-> IsStrictlySequential -> [Tag] -> TextParser (PGNDatabase x y)
parser IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves [Tag]
identificationTags

-- | The name of an executable used to decompress (to stdout) the PGN-file.
type Decompressor	= String

-- | Reads a PGN-database from the (optionally compressed) file-path & passes it to the parser.
parseIO :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 )
	=> System.FilePath.FilePath	-- ^ The PGN-file's location.
	-> Maybe Decompressor		-- ^ An Optional executable by which to decompress the PGN-file.
	-> ContextualNotation.PGN.IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> System.IO.TextEncoding	-- ^ The conversion-scheme between byte-sequences & Unicode characters.
	-> [ContextualNotation.PGN.Tag]
	-> PGNPredicate x y		-- ^ Used to filter entries from the database.
	-> MaybeMaximumGames		-- ^ Optional maximum number of games to read from the database (after they've been filtered).
	-> IO (Either String (PGNDatabase x y))
{-# SPECIALISE parseIO :: System.FilePath.FilePath -> Maybe Decompressor -> ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> System.IO.TextEncoding -> [ContextualNotation.PGN.Tag] -> PGNPredicate Type.Length.X Type.Length.Y -> MaybeMaximumGames -> IO (Either String (PGNDatabase Type.Length.X Type.Length.Y)) #-}
parseIO :: Tag
-> Maybe Tag
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [Tag]
-> PGNPredicate x y
-> MaybeMaximumGames
-> IO (Either Tag (PGNDatabase x y))
parseIO Tag
filePath Maybe Tag
maybeDecompressionCommand IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves TextEncoding
textEncoding [Tag]
identificationTags PGNPredicate x y
pgnPredicate MaybeMaximumGames
maybeMaximumGames	= Tag
-> IsStrictlySequential
-> IsStrictlySequential
-> [Tag]
-> PGNPredicate x y
-> MaybeMaximumGames
-> Tag
-> Either Tag (PGNDatabase x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Tag
-> IsStrictlySequential
-> IsStrictlySequential
-> [Tag]
-> PGNPredicate x y
-> MaybeMaximumGames
-> Tag
-> Either Tag (PGNDatabase x y)
parse Tag
filePath IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves [Tag]
identificationTags PGNPredicate x y
pgnPredicate MaybeMaximumGames
maybeMaximumGames (Tag -> Either Tag (PGNDatabase x y))
-> IO Tag -> IO (Either Tag (PGNDatabase x y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO Tag -> (Tag -> IO Tag) -> Maybe Tag -> IO Tag
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
	Tag -> IOMode -> (Handle -> IO Tag) -> IO Tag
forall r. Tag -> IOMode -> (Handle -> IO r) -> IO r
System.IO.withFile Tag
filePath IOMode
System.IO.ReadMode ((Handle -> IO Tag) -> IO Tag) -> (Handle -> IO Tag) -> IO Tag
forall a b. (a -> b) -> a -> b
$ \Handle
fileHandle -> do
		Handle -> TextEncoding -> IO ()
System.IO.hSetEncoding Handle
fileHandle TextEncoding
textEncoding

		Tag
contents	<- Handle -> IO Tag
System.IO.hGetContents Handle
fileHandle

		Tag -> IO Tag
forall (m :: * -> *) a. Monad m => a -> m a
return {-to IO-monad-} (Tag -> IO Tag) -> Tag -> IO Tag
forall a b. NFData a => (a -> b) -> a -> b
$!! Tag
contents	-- CAVEAT: evaluate the contents before the file is closed.
 ) (
	\Tag
decompressor	-> do
		(ExitCode
exitCode, Tag
stdOut, Tag
stdErr)	<- Tag -> [Tag] -> Tag -> IO (ExitCode, Tag, Tag)
System.Process.readProcessWithExitCode Tag
decompressor [Tag
filePath] [{-stdIn-}]

		IsStrictlySequential -> IO () -> IO ()
forall (f :: * -> *).
Applicative f =>
IsStrictlySequential -> f () -> f ()
Control.Monad.unless (ExitCode
exitCode ExitCode -> ExitCode -> IsStrictlySequential
forall a. Eq a => a -> a -> IsStrictlySequential
== ExitCode
System.Exit.ExitSuccess) (IO () -> IO ()) -> (Tag -> IO ()) -> Tag -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exception -> IO ()
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (Exception -> IO ()) -> (Tag -> Exception) -> Tag -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Exception
Data.Exception.mkRequestFailure (Tag -> IO ()) -> Tag -> IO ()
forall a b. (a -> b) -> a -> b
$ Tag -> Tag -> Tag
showString Tag
"BishBosh.ContextualNotation.PGNDatabase.decompress:\t" Tag
stdErr

		Tag -> IO Tag
forall (m :: * -> *) a. Monad m => a -> m a
return {-to IO-monad-} Tag
stdOut
 ) Maybe Tag
maybeDecompressionCommand