{-
	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 configurable options for PGN-processing.
-}

module BishBosh.Input.PGNOptions(
-- * Types
-- ** Type-synonyms
-- ** Data-types
	PGNOptions(
--		MkPGNOptions,
		getDatabaseFilePath,
		getIsStrictlySequential,
		getValidateMoves,
		getTextEncoding,
		getIdentificationTags,
		getMinimumPlies
	),
-- * Constants
	tag,
	databaseFilePathTag,
--	identificationTagTag,
--	minimumPliesTag,
-- * Functions
-- ** Constructor
	mkPGNOptions
) where

import qualified	BishBosh.Component.Move				as Component.Move
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.Text.Encoding				as Text.Encoding
import qualified	BishBosh.Text.ShowList				as Text.ShowList
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	System.FilePath
import qualified	System.IO
import qualified	Text.XML.HXT.Arrow.Pickle			as HXT
import qualified	ToolShed.Data.Foldable

-- | Used to qualify XML.
tag :: String
tag :: String
tag			= String
"pgnOptions"

-- | Used to qualify XML.
databaseFilePathTag :: String
databaseFilePathTag :: String
databaseFilePathTag	= String
"databaseFilePath"

-- | Defines the command-line options.
validateMovesTag :: String
validateMovesTag :: String
validateMovesTag	= String
"validateMoves"

-- | Defines the command-line options.
isStrictlySequentialTag :: String
isStrictlySequentialTag :: String
isStrictlySequentialTag	= String
"isStrictlySequential"

-- | Defines the command-line options.
identificationTagTag :: String
identificationTagTag :: String
identificationTagTag	= String
"identificationTag"

-- | Defines the command-line options.
minimumPliesTag :: String
minimumPliesTag :: String
minimumPliesTag		= String
"minimumPlies"

-- | Defines the options related to PGN.
data PGNOptions	= MkPGNOptions {
	PGNOptions -> String
getDatabaseFilePath	:: System.FilePath.FilePath,				-- ^ Path to a PGN-database file.
	PGNOptions -> IsStrictlySequential
getIsStrictlySequential	:: ContextualNotation.PGN.IsStrictlySequential,		-- ^ Whether moves with an unexpected number should be considered to be an error.
	PGNOptions -> IsStrictlySequential
getValidateMoves	:: ContextualNotation.StandardAlgebraic.ValidateMoves,	-- ^ Whether moves should be validated, which can become tedious if they're already known to be valid.
	PGNOptions -> TextEncoding
getTextEncoding		:: System.IO.TextEncoding,				-- ^ The conversion-scheme between byte-sequences & Unicode characters.
	PGNOptions -> [String]
getIdentificationTags	:: [ContextualNotation.PGN.Tag],			-- ^ The tags to extract from this PGN-database to form a unique composite game-identifier.
	PGNOptions -> NMoves
getMinimumPlies		:: Component.Move.NMoves				-- ^ The minimum number of half moves, for the game to be considered useful; most short games result from "forfeit by disconnection".
} deriving PGNOptions -> PGNOptions -> IsStrictlySequential
(PGNOptions -> PGNOptions -> IsStrictlySequential)
-> (PGNOptions -> PGNOptions -> IsStrictlySequential)
-> Eq PGNOptions
forall a.
(a -> a -> IsStrictlySequential)
-> (a -> a -> IsStrictlySequential) -> Eq a
/= :: PGNOptions -> PGNOptions -> IsStrictlySequential
$c/= :: PGNOptions -> PGNOptions -> IsStrictlySequential
== :: PGNOptions -> PGNOptions -> IsStrictlySequential
$c== :: PGNOptions -> PGNOptions -> IsStrictlySequential
Eq

instance Control.DeepSeq.NFData PGNOptions where
	rnf :: PGNOptions -> ()
rnf MkPGNOptions {
		getDatabaseFilePath :: PGNOptions -> String
getDatabaseFilePath	= String
databaseFilePath,
		getIsStrictlySequential :: PGNOptions -> IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
isStrictlySequential,
		getValidateMoves :: PGNOptions -> IsStrictlySequential
getValidateMoves	= IsStrictlySequential
validateMoves,
		getIdentificationTags :: PGNOptions -> [String]
getIdentificationTags	= [String]
identificationTags,
		getMinimumPlies :: PGNOptions -> NMoves
getMinimumPlies		= NMoves
minimumPlies
	} = (String, IsStrictlySequential, IsStrictlySequential, [String],
 NMoves)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (String
databaseFilePath, IsStrictlySequential
isStrictlySequential, IsStrictlySequential
validateMoves, [String]
identificationTags, NMoves
minimumPlies)

instance Show PGNOptions where
	showsPrec :: NMoves -> PGNOptions -> ShowS
showsPrec NMoves
_ MkPGNOptions {
		getDatabaseFilePath :: PGNOptions -> String
getDatabaseFilePath	= String
databaseFilePath,
		getIsStrictlySequential :: PGNOptions -> IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
isStrictlySequential,
		getValidateMoves :: PGNOptions -> IsStrictlySequential
getValidateMoves	= IsStrictlySequential
validateMoves,
		getTextEncoding :: PGNOptions -> TextEncoding
getTextEncoding		= TextEncoding
textEncoding,
		getIdentificationTags :: PGNOptions -> [String]
getIdentificationTags	= [String]
identificationTags,
		getMinimumPlies :: PGNOptions -> NMoves
getMinimumPlies		= NMoves
minimumPlies
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' [
		(
			String
databaseFilePathTag,
			String -> ShowS
forall a. Show a => a -> ShowS
shows String
databaseFilePath
		), (
			String
isStrictlySequentialTag,
			IsStrictlySequential -> ShowS
forall a. Show a => a -> ShowS
shows IsStrictlySequential
isStrictlySequential
		), (
			String
validateMovesTag,
			IsStrictlySequential -> ShowS
forall a. Show a => a -> ShowS
shows IsStrictlySequential
validateMoves
		), (
			String
Text.Encoding.tag,
			TextEncoding -> ShowS
forall a. Show a => a -> ShowS
shows TextEncoding
textEncoding
		), (
			String -> ShowS
showString String
identificationTagTag String
"s",
			[String] -> ShowS
forall a. Show a => a -> ShowS
shows [String]
identificationTags
		), (
			String
minimumPliesTag,
			NMoves -> ShowS
forall a. Show a => a -> ShowS
shows NMoves
minimumPlies
		)
	 ]

instance Data.Default.Default PGNOptions where
	def :: PGNOptions
def = MkPGNOptions :: String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NMoves
-> PGNOptions
MkPGNOptions {
		getDatabaseFilePath :: String
getDatabaseFilePath	= String
"pgn/bishbosh.pgn",	-- CAVEAT: rather arbitrary.
		getIsStrictlySequential :: IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
True,
		getValidateMoves :: IsStrictlySequential
getValidateMoves	= IsStrictlySequential
True,
		getTextEncoding :: TextEncoding
getTextEncoding		= TextEncoding
forall a. Default a => a
Data.Default.def,
		getIdentificationTags :: [String]
getIdentificationTags	= [String
"ECO", String
"Variation"],	-- CAVEAT: rather arbitrary.
		getMinimumPlies :: NMoves
getMinimumPlies		= NMoves
1
	}

instance HXT.XmlPickler PGNOptions where
	xpickle :: PU PGNOptions
xpickle	= String -> PU PGNOptions -> PU PGNOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU PGNOptions -> PU PGNOptions)
-> (PU
      (String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
       [String], NMoves)
    -> PU PGNOptions)
-> PU
     (String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
      [String], NMoves)
-> PU PGNOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
  [String], NMoves)
 -> PGNOptions,
 PGNOptions
 -> (String, IsStrictlySequential, IsStrictlySequential,
     TextEncoding, [String], NMoves))
-> PU
     (String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
      [String], NMoves)
-> PU PGNOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(String
a, IsStrictlySequential
b, IsStrictlySequential
c, TextEncoding
d, [String]
e, NMoves
f) -> String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NMoves
-> PGNOptions
mkPGNOptions String
a IsStrictlySequential
b IsStrictlySequential
c TextEncoding
d [String]
e NMoves
f,	-- Construct.
		\MkPGNOptions {
			getDatabaseFilePath :: PGNOptions -> String
getDatabaseFilePath	= String
databaseFilePath,
			getIsStrictlySequential :: PGNOptions -> IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
isStrictlySequential,
			getValidateMoves :: PGNOptions -> IsStrictlySequential
getValidateMoves	= IsStrictlySequential
validateMoves,
			getTextEncoding :: PGNOptions -> TextEncoding
getTextEncoding		= TextEncoding
textEncoding,
			getIdentificationTags :: PGNOptions -> [String]
getIdentificationTags	= [String]
identificationTags,
			getMinimumPlies :: PGNOptions -> NMoves
getMinimumPlies		= NMoves
minimumPlies
		} -> (String
databaseFilePath, IsStrictlySequential
isStrictlySequential, IsStrictlySequential
validateMoves, TextEncoding
textEncoding, [String]
identificationTags, NMoves
minimumPlies) -- Deconstruct.
	 ) (PU
   (String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
    [String], NMoves)
 -> PU PGNOptions)
-> PU
     (String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
      [String], NMoves)
-> PU PGNOptions
forall a b. (a -> b) -> a -> b
$ PU String
-> PU IsStrictlySequential
-> PU IsStrictlySequential
-> PU TextEncoding
-> PU [String]
-> PU NMoves
-> PU
     (String, IsStrictlySequential, IsStrictlySequential, TextEncoding,
      [String], NMoves)
forall a b c d e f.
PU a
-> PU b -> PU c -> PU d -> PU e -> PU f -> PU (a, b, c, d, e, f)
HXT.xp6Tuple (
		String -> PU String
HXT.xpTextAttr String
databaseFilePathTag
	 ) (
		PGNOptions -> IsStrictlySequential
getIsStrictlySequential PGNOptions
def IsStrictlySequential
-> PU IsStrictlySequential -> PU IsStrictlySequential
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU IsStrictlySequential -> PU IsStrictlySequential
forall a. String -> PU a -> PU a
HXT.xpAttr String
isStrictlySequentialTag PU IsStrictlySequential
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (
		PGNOptions -> IsStrictlySequential
getValidateMoves PGNOptions
def IsStrictlySequential
-> PU IsStrictlySequential -> PU IsStrictlySequential
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU IsStrictlySequential -> PU IsStrictlySequential
forall a. String -> PU a -> PU a
HXT.xpAttr String
validateMovesTag PU IsStrictlySequential
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) PU TextEncoding
forall a. XmlPickler a => PU a
HXT.xpickle {-TextEncoding-} (
		PU String -> PU [String]
forall a. PU a -> PU [a]
HXT.xpList (PU String -> PU [String])
-> (PU String -> PU String) -> PU String -> PU [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpElem String
identificationTagTag (PU String -> PU [String]) -> PU String -> PU [String]
forall a b. (a -> b) -> a -> b
$ String -> PU String
HXT.xpTextAttr String
"tag"
	 ) (
		PGNOptions -> NMoves
getMinimumPlies PGNOptions
def NMoves -> PU NMoves -> PU NMoves
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU NMoves -> PU NMoves
forall a. String -> PU a -> PU a
HXT.xpAttr String
minimumPliesTag PU NMoves
forall a. XmlPickler a => PU a
HXT.xpickle {-NMoves-}
	 ) where
		def :: PGNOptions
def	= PGNOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkPGNOptions
	:: System.FilePath.FilePath	-- ^ Database file-path.
	-> ContextualNotation.PGN.IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> System.IO.TextEncoding
	-> [ContextualNotation.PGN.Tag]	-- ^ Optional identification tags.
	-> Component.Move.NMoves	-- ^ The minimum plies.
	-> PGNOptions
mkPGNOptions :: String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NMoves
-> PGNOptions
mkPGNOptions String
databaseFilePath IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves TextEncoding
textEncoding [String]
identificationTags NMoves
minimumPlies
	| IsStrictlySequential -> IsStrictlySequential
not (IsStrictlySequential -> IsStrictlySequential)
-> IsStrictlySequential -> IsStrictlySequential
forall a b. (a -> b) -> a -> b
$ String -> IsStrictlySequential
System.FilePath.isValid String
databaseFilePath	= Exception -> PGNOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PGNOptions)
-> (String -> Exception) -> String -> PGNOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PGNOptions.mkPGNOptions:\tinvalid " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
databaseFilePathTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> PGNOptions) -> String -> PGNOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
databaseFilePath String
"."
	| (String -> IsStrictlySequential)
-> [String] -> IsStrictlySequential
forall (t :: * -> *) a.
Foldable t =>
(a -> IsStrictlySequential) -> t a -> IsStrictlySequential
any String -> IsStrictlySequential
forall (t :: * -> *) a. Foldable t => t a -> IsStrictlySequential
null [String]
identificationTags				= Exception -> PGNOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PGNOptions)
-> (String -> Exception) -> String -> PGNOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkNullDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PGNOptions.mkPGNOptions:\tno " (String -> PGNOptions) -> String -> PGNOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
identificationTagTag String
" can be null."
	| duplicateTags :: [String]
duplicateTags@(String
_ : [String]
_)	<- ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall a. [a] -> a
head ([[String]] -> [String])
-> ([[String]] -> [[String]]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> IsStrictlySequential) -> [[String]] -> [[String]]
forall a. (a -> IsStrictlySequential) -> [a] -> [a]
filter ((NMoves -> NMoves -> IsStrictlySequential
forall a. Eq a => a -> a -> IsStrictlySequential
/= NMoves
1) (NMoves -> IsStrictlySequential)
-> ([String] -> NMoves) -> [String] -> IsStrictlySequential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> NMoves
forall (t :: * -> *) a. Foldable t => t a -> NMoves
length) ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [[String]]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [[a]]
ToolShed.Data.Foldable.gather [String]
identificationTags
	= Exception -> PGNOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PGNOptions)
-> (String -> Exception) -> String -> PGNOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PGNOptions.mkPGNOptions:\tduplicate " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
identificationTagTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
's' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> PGNOptions) -> String -> PGNOptions
forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
forall a. Show a => a -> ShowS
shows [String]
duplicateTags String
"."
	| NMoves
minimumPlies NMoves -> NMoves -> IsStrictlySequential
forall a. Ord a => a -> a -> IsStrictlySequential
< NMoves
0					= Exception -> PGNOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PGNOptions)
-> (String -> Exception) -> String -> PGNOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PGNOptions.mkPGNOptions:\t" (String -> PGNOptions) -> String -> PGNOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
minimumPliesTag String
" can't be negative."
	| IsStrictlySequential
otherwise						= MkPGNOptions :: String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NMoves
-> PGNOptions
MkPGNOptions {
		getDatabaseFilePath :: String
getDatabaseFilePath	= ShowS
System.FilePath.normalise String
databaseFilePath,
		getIsStrictlySequential :: IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
isStrictlySequential,
		getValidateMoves :: IsStrictlySequential
getValidateMoves	= IsStrictlySequential
validateMoves,
		getTextEncoding :: TextEncoding
getTextEncoding		= TextEncoding
textEncoding,
		getIdentificationTags :: [String]
getIdentificationTags	= [String]
identificationTags,
		getMinimumPlies :: NMoves
getMinimumPlies		= NMoves
minimumPlies
	}