{-
	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,
		getMaybeDecompressor,
		getIsStrictlySequential,
		getValidateMoves,
		getTextEncoding,
		getIdentificationTags,
		getMinimumPlies,
		getMaybeMaximumGames
	),
-- * Constants
	tag,
	databaseFilePathTag,
--	decompressorTag,
--	validateMovesTag,
--	isStrictlySequentialTag,
--	identificationTagTag,
--	minimumPliesTag,
--	maximumGamesTag,
-- * Functions
-- ** Constructor
	mkPGNOptions
) where

import			BishBosh.Data.Bool()
import qualified	BishBosh.ContextualNotation.PGN			as ContextualNotation.PGN
import qualified	BishBosh.ContextualNotation.PGNDatabase		as ContextualNotation.PGNDatabase
import qualified	BishBosh.ContextualNotation.StandardAlgebraic	as ContextualNotation.StandardAlgebraic
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Data.Foldable				as Data.Foldable
import qualified	BishBosh.Text.Encoding				as Text.Encoding
import qualified	BishBosh.Text.ShowList				as Text.ShowList
import qualified	BishBosh.Type.Count				as Type.Count
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Char
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	System.FilePath
import qualified	System.IO
import qualified	Text.XML.HXT.Arrow.Pickle			as HXT

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

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

-- | Used to qualify XML.
decompressorTag :: String
decompressorTag :: String
decompressorTag		= String
"decompressor"

-- | 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 command-line options.
maximumGamesTag :: String
maximumGamesTag :: String
maximumGamesTag		= String
"maximumGames"

-- | Defines the options related to PGN.
data PGNOptions	= MkPGNOptions {
	PGNOptions -> String
getDatabaseFilePath	:: System.FilePath.FilePath,				-- ^ Path to a PGN-database file.
	PGNOptions -> Maybe String
getMaybeDecompressor	:: Maybe ContextualNotation.PGNDatabase.Decompressor,	-- ^ Optional executable by which to decompress the specified 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 -> NPlies
getMinimumPlies		:: Type.Count.NPlies,					-- ^ The minimum number of plies required before a recorded game is considered useful.
	PGNOptions -> MaybeMaximumGames
getMaybeMaximumGames	:: ContextualNotation.PGNDatabase.MaybeMaximumGames	-- ^ The optional maximum number of games to read from the PGN-database.
} 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,
		getMaybeDecompressor :: PGNOptions -> Maybe String
getMaybeDecompressor	= Maybe String
maybeDecompressor,
		getIsStrictlySequential :: PGNOptions -> IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
isStrictlySequential,
		getValidateMoves :: PGNOptions -> IsStrictlySequential
getValidateMoves	= IsStrictlySequential
validateMoves,
		getIdentificationTags :: PGNOptions -> [String]
getIdentificationTags	= [String]
identificationTags,
		getMinimumPlies :: PGNOptions -> NPlies
getMinimumPlies		= NPlies
minimumPlies,
		getMaybeMaximumGames :: PGNOptions -> MaybeMaximumGames
getMaybeMaximumGames	= MaybeMaximumGames
maybeMaximumGames
	} = (String, Maybe String, IsStrictlySequential, IsStrictlySequential,
 [String], NPlies, MaybeMaximumGames)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (String
databaseFilePath, Maybe String
maybeDecompressor, IsStrictlySequential
isStrictlySequential, IsStrictlySequential
validateMoves, [String]
identificationTags, NPlies
minimumPlies, MaybeMaximumGames
maybeMaximumGames)

instance Show PGNOptions where
	showsPrec :: NPlies -> PGNOptions -> ShowS
showsPrec NPlies
_ MkPGNOptions {
		getDatabaseFilePath :: PGNOptions -> String
getDatabaseFilePath	= String
databaseFilePath,
		getMaybeDecompressor :: PGNOptions -> Maybe String
getMaybeDecompressor	= Maybe String
maybeDecompressor,
		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 -> NPlies
getMinimumPlies		= NPlies
minimumPlies,
		getMaybeMaximumGames :: PGNOptions -> MaybeMaximumGames
getMaybeMaximumGames	= MaybeMaximumGames
maybeMaximumGames
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([(String, ShowS)] -> [(String, ShowS)])
-> (String -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe String
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [(String, ShowS)] -> [(String, ShowS)]
forall a. a -> a
id (
		(:) ((String, ShowS) -> [(String, ShowS)] -> [(String, ShowS)])
-> (String -> (String, ShowS))
-> String
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
decompressorTag (ShowS -> (String, ShowS))
-> (String -> ShowS) -> String -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe String
maybeDecompressor [
		(
			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,
			NPlies -> ShowS
forall a. Show a => a -> ShowS
shows NPlies
minimumPlies
		), (
			String
maximumGamesTag,
			MaybeMaximumGames -> ShowS
forall a. Show a => a -> ShowS
shows MaybeMaximumGames
maybeMaximumGames
		)
	 ]

instance Data.Default.Default PGNOptions where
	def :: PGNOptions
def = MkPGNOptions :: String
-> Maybe String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NPlies
-> MaybeMaximumGames
-> PGNOptions
MkPGNOptions {
		getDatabaseFilePath :: String
getDatabaseFilePath	= String
"pgn/bishbosh.pgn",	-- CAVEAT: rather arbitrary.
		getMaybeDecompressor :: Maybe String
getMaybeDecompressor	= Maybe String
forall a. Maybe a
Nothing,
		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 :: NPlies
getMinimumPlies		= NPlies
1,
		getMaybeMaximumGames :: MaybeMaximumGames
getMaybeMaximumGames	= MaybeMaximumGames
forall a. Maybe a
Nothing
	}

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, Maybe String, IsStrictlySequential, IsStrictlySequential,
       TextEncoding, [String], NPlies, MaybeMaximumGames)
    -> PU PGNOptions)
-> PU
     (String, Maybe String, IsStrictlySequential, IsStrictlySequential,
      TextEncoding, [String], NPlies, MaybeMaximumGames)
-> PU PGNOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Maybe String, IsStrictlySequential, IsStrictlySequential,
  TextEncoding, [String], NPlies, MaybeMaximumGames)
 -> PGNOptions,
 PGNOptions
 -> (String, Maybe String, IsStrictlySequential,
     IsStrictlySequential, TextEncoding, [String], NPlies,
     MaybeMaximumGames))
-> PU
     (String, Maybe String, IsStrictlySequential, IsStrictlySequential,
      TextEncoding, [String], NPlies, MaybeMaximumGames)
-> PU PGNOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(String
a, Maybe String
b, IsStrictlySequential
c, IsStrictlySequential
d, TextEncoding
e, [String]
f, NPlies
g, MaybeMaximumGames
h) -> String
-> Maybe String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NPlies
-> MaybeMaximumGames
-> PGNOptions
mkPGNOptions String
a Maybe String
b IsStrictlySequential
c IsStrictlySequential
d TextEncoding
e [String]
f NPlies
g MaybeMaximumGames
h,	-- Construct.
		\MkPGNOptions {
			getDatabaseFilePath :: PGNOptions -> String
getDatabaseFilePath	= String
databaseFilePath,
			getMaybeDecompressor :: PGNOptions -> Maybe String
getMaybeDecompressor	= Maybe String
maybeDecompressor,
			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 -> NPlies
getMinimumPlies		= NPlies
minimumPlies,
			getMaybeMaximumGames :: PGNOptions -> MaybeMaximumGames
getMaybeMaximumGames	= MaybeMaximumGames
maybeMaximumGames
		} -> (String
databaseFilePath, Maybe String
maybeDecompressor, IsStrictlySequential
isStrictlySequential, IsStrictlySequential
validateMoves, TextEncoding
textEncoding, [String]
identificationTags, NPlies
minimumPlies, MaybeMaximumGames
maybeMaximumGames) -- Deconstruct.
	 ) (PU
   (String, Maybe String, IsStrictlySequential, IsStrictlySequential,
    TextEncoding, [String], NPlies, MaybeMaximumGames)
 -> PU PGNOptions)
-> PU
     (String, Maybe String, IsStrictlySequential, IsStrictlySequential,
      TextEncoding, [String], NPlies, MaybeMaximumGames)
-> PU PGNOptions
forall a b. (a -> b) -> a -> b
$ PU String
-> PU (Maybe String)
-> PU IsStrictlySequential
-> PU IsStrictlySequential
-> PU TextEncoding
-> PU [String]
-> PU NPlies
-> PU MaybeMaximumGames
-> PU
     (String, Maybe String, IsStrictlySequential, IsStrictlySequential,
      TextEncoding, [String], NPlies, MaybeMaximumGames)
forall a b c d e f g h.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU (a, b, c, d, e, f, g, h)
HXT.xp8Tuple (
		String -> PU String
HXT.xpTextAttr String
databaseFilePathTag
	 ) (
		PU String -> PU (Maybe String)
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU String -> PU (Maybe String)) -> PU String -> PU (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> PU String
HXT.xpTextAttr String
decompressorTag
	 ) (
		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 -> NPlies
getMinimumPlies PGNOptions
def NPlies -> PU NPlies -> PU NPlies
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU NPlies -> PU NPlies
forall a. String -> PU a -> PU a
HXT.xpAttr String
minimumPliesTag PU NPlies
forall a. XmlPickler a => PU a
HXT.xpickle {-NPlies-}
	 ) (
		PU NPlies -> PU MaybeMaximumGames
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU NPlies -> PU MaybeMaximumGames)
-> PU NPlies -> PU MaybeMaximumGames
forall a b. (a -> b) -> a -> b
$ String -> PU NPlies -> PU NPlies
forall a. String -> PU a -> PU a
HXT.xpAttr String
maximumGamesTag PU NPlies
forall a. XmlPickler a => PU a
HXT.xpickle {-NGames-}
	 ) where
		def :: PGNOptions
def	= PGNOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkPGNOptions
	:: System.FilePath.FilePath				-- ^ Database file-path.
	-> Maybe ContextualNotation.PGNDatabase.Decompressor	-- ^ Optional name of an executable by which to decompress the specified file.
	-> ContextualNotation.PGN.IsStrictlySequential
	-> ContextualNotation.StandardAlgebraic.ValidateMoves
	-> System.IO.TextEncoding
	-> [ContextualNotation.PGN.Tag]				-- ^ Optional identification tags.
	-> Type.Count.NPlies					-- ^ The minimum plies.
	-> ContextualNotation.PGNDatabase.MaybeMaximumGames	-- ^ The optional maximum number of games to read from the database.
	-> PGNOptions
mkPGNOptions :: String
-> Maybe String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NPlies
-> MaybeMaximumGames
-> PGNOptions
mkPGNOptions String
databaseFilePath Maybe String
maybeDecompressor IsStrictlySequential
isStrictlySequential IsStrictlySequential
validateMoves TextEncoding
textEncoding [String]
identificationTags NPlies
minimumPlies MaybeMaximumGames
maybeMaximumGames
	| 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
"."
	| IsStrictlySequential
-> (String -> IsStrictlySequential)
-> Maybe String
-> IsStrictlySequential
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsStrictlySequential
False String -> IsStrictlySequential
forall (t :: * -> *) a. Foldable t => t a -> IsStrictlySequential
null Maybe String
maybeDecompressor		= 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:\t" (String -> PGNOptions) -> String -> PGNOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
decompressorTag String
" can't be null."
	| IsStrictlySequential
-> (String -> IsStrictlySequential)
-> Maybe String
-> IsStrictlySequential
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsStrictlySequential
False (
		IsStrictlySequential -> IsStrictlySequential
not (IsStrictlySequential -> IsStrictlySequential)
-> (String -> IsStrictlySequential)
-> String
-> IsStrictlySequential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> IsStrictlySequential) -> String -> IsStrictlySequential
forall (t :: * -> *) a.
Foldable t =>
(a -> IsStrictlySequential) -> t a -> IsStrictlySequential
all Char -> IsStrictlySequential
Data.Char.isAlphaNum
	) Maybe String
maybeDecompressor					= 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:\t" (String -> PGNOptions) -> String -> PGNOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
decompressorTag String
" should be alpha-numeric."
	| (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."
	| IsStrictlySequential -> IsStrictlySequential
not (IsStrictlySequential -> IsStrictlySequential)
-> IsStrictlySequential -> IsStrictlySequential
forall a b. (a -> b) -> a -> b
$ [String] -> IsStrictlySequential
forall (t :: * -> *) a. Foldable t => t a -> IsStrictlySequential
null [String]
duplicateIdentificationTags		= 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
. 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]
duplicateIdentificationTags String
"."
	| NPlies
minimumPlies NPlies -> NPlies -> IsStrictlySequential
forall a. Ord a => a -> a -> IsStrictlySequential
< NPlies
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
-> (NPlies -> IsStrictlySequential)
-> MaybeMaximumGames
-> IsStrictlySequential
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe IsStrictlySequential
False (NPlies -> NPlies -> IsStrictlySequential
forall a. Ord a => a -> a -> IsStrictlySequential
<= NPlies
0) MaybeMaximumGames
maybeMaximumGames	= 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
maximumGamesTag String
" must be positive."
	| IsStrictlySequential
otherwise						= MkPGNOptions :: String
-> Maybe String
-> IsStrictlySequential
-> IsStrictlySequential
-> TextEncoding
-> [String]
-> NPlies
-> MaybeMaximumGames
-> PGNOptions
MkPGNOptions {
		getDatabaseFilePath :: String
getDatabaseFilePath	= ShowS
System.FilePath.normalise String
databaseFilePath,
		getMaybeDecompressor :: Maybe String
getMaybeDecompressor	= Maybe String
maybeDecompressor,
		getIsStrictlySequential :: IsStrictlySequential
getIsStrictlySequential	= IsStrictlySequential
isStrictlySequential,
		getValidateMoves :: IsStrictlySequential
getValidateMoves	= IsStrictlySequential
validateMoves,
		getTextEncoding :: TextEncoding
getTextEncoding		= TextEncoding
textEncoding,
		getIdentificationTags :: [String]
getIdentificationTags	= [String]
identificationTags,
		getMinimumPlies :: NPlies
getMinimumPlies		= NPlies
minimumPlies,
		getMaybeMaximumGames :: MaybeMaximumGames
getMaybeMaximumGames	= MaybeMaximumGames
maybeMaximumGames
	}
	where
		duplicateIdentificationTags :: [String]
duplicateIdentificationTags	= [String] -> [String]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [a]
Data.Foldable.findDuplicates [String]
identificationTags