{-
	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.

	* CAVEAT: whilst naively, the flexibility of each automated player owning their own independent /EvaluationOptions/, seems attractive,
	that choice then requires maintainance of two independently quantified (& large) /PositionHashQuantifiedGameTree/s.
-}

module BishBosh.Input.Options(
-- * Types
-- ** Type-synonyms
--	Transformation,
	RandomSeed,
-- ** Data-types
	Options(
--		MkOptions,
		getMaybeMaximumPlies,
		getMaybeRandomSeed,
		getEvaluationOptions,
		getSearchOptions,
		getIOOptions
	),
-- * Constants
	tag,
	maximumPliesTag,
	randomSeedTag,
-- * Functions
-- ** Constructor
	mkOptions,
-- ** Mutators
	setMaybeOutputConfigFilePath,
	setMaybeRandomSeed,
	setMaybePersistence,
	setVerbosity,
	setEitherNativeUIOrCECPOptions,
	setMaybePrintMoveTree,
	swapSearchDepth
) where

import			BishBosh.Data.Bool()		-- For 'HXT.xpickle'.
import qualified	BishBosh.Data.Exception			as Data.Exception
import qualified	BishBosh.Input.EvaluationOptions	as Input.EvaluationOptions
import qualified	BishBosh.Input.IOOptions		as Input.IOOptions
import qualified	BishBosh.Input.PGNOptions		as Input.PGNOptions
import qualified	BishBosh.Input.SearchOptions		as Input.SearchOptions
import qualified	BishBosh.Input.UIOptions		as Input.UIOptions
import qualified	BishBosh.Input.Verbosity		as Input.Verbosity
import qualified	BishBosh.Property.Arboreal		as Property.Arboreal
import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat
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.Default
import qualified	Data.Maybe
import qualified	System.FilePath
import qualified	Text.XML.HXT.Arrow.Pickle		as HXT

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

-- | Used to qualify XML.
maximumPliesTag :: String
maximumPliesTag :: String
maximumPliesTag		= String
"maximumPlies"

-- | Used to qualify XML.
randomSeedTag :: String
randomSeedTag :: String
randomSeedTag		= String
"randomSeed"

-- | A seed from which to construct a pseudo-random number-generator.
type RandomSeed	= Int

-- | Defines the application's options.
data Options	= MkOptions {
	Options -> Maybe NPlies
getMaybeMaximumPlies	:: Maybe Type.Count.NPlies,			-- ^ The maximum number of plies before the game is terminated; required for profiling the application.
	Options -> Maybe NPlies
getMaybeRandomSeed	:: Maybe RandomSeed,				-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.
	Options -> EvaluationOptions
getEvaluationOptions	:: Input.EvaluationOptions.EvaluationOptions,	-- ^ The single set of options by which all automated /move/s are evaluated.
	Options -> SearchOptions
getSearchOptions	:: Input.SearchOptions.SearchOptions,		-- ^ The options by which to automatically select /move/s.
	Options -> IOOptions
getIOOptions		:: Input.IOOptions.IOOptions			-- ^ The /ioOptions/ by which to receive commands & present results.
} deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, NPlies -> Options -> ShowS
[Options] -> ShowS
Options -> String
(NPlies -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(NPlies -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: NPlies -> Options -> ShowS
$cshowsPrec :: NPlies -> Options -> ShowS
Show)

instance Control.DeepSeq.NFData Options where
	rnf :: Options -> ()
rnf MkOptions {
		getMaybeMaximumPlies :: Options -> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: Options -> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: Options -> EvaluationOptions
getEvaluationOptions	= EvaluationOptions
evaluationOptions,
		getSearchOptions :: Options -> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: Options -> IOOptions
getIOOptions		= IOOptions
ioOptions
	} = (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
 IOOptions)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Maybe NPlies
maybeMaximumPlies, Maybe NPlies
maybeRandomSeed, EvaluationOptions
evaluationOptions, SearchOptions
searchOptions, IOOptions
ioOptions)

instance Property.ShowFloat.ShowFloat Options where
	showsFloat :: (Double -> ShowS) -> Options -> ShowS
showsFloat Double -> ShowS
fromDouble MkOptions {
		getMaybeMaximumPlies :: Options -> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: Options -> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: Options -> EvaluationOptions
getEvaluationOptions	= EvaluationOptions
evaluationOptions,
		getSearchOptions :: Options -> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: Options -> IOOptions
getIOOptions		= IOOptions
ioOptions
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> ([(String, ShowS)] -> [(String, ShowS)])
-> [(String, ShowS)]
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, ShowS)] -> [(String, ShowS)])
-> (NPlies -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe NPlies
-> [(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)])
-> (NPlies -> (String, ShowS))
-> NPlies
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
maximumPliesTag (ShowS -> (String, ShowS))
-> (NPlies -> ShowS) -> NPlies -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPlies -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe NPlies
maybeMaximumPlies ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([(String, ShowS)] -> [(String, ShowS)])
-> (NPlies -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe NPlies
-> [(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)])
-> (NPlies -> (String, ShowS))
-> NPlies
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
randomSeedTag (ShowS -> (String, ShowS))
-> (NPlies -> ShowS) -> NPlies -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NPlies -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe NPlies
maybeRandomSeed [
		(
			String
Input.EvaluationOptions.tag,
			(Double -> ShowS) -> EvaluationOptions -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble EvaluationOptions
evaluationOptions
		), (
			String
Input.SearchOptions.tag,
			SearchOptions -> ShowS
forall a. Show a => a -> ShowS
shows SearchOptions
searchOptions
		), (
			String
Input.IOOptions.tag,
			IOOptions -> ShowS
forall a. Show a => a -> ShowS
shows IOOptions
ioOptions
		)
	 ]

instance Data.Default.Default Options where
	def :: Options
def = MkOptions :: Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions
-> SearchOptions
-> IOOptions
-> Options
MkOptions {
		getMaybeMaximumPlies :: Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
forall a. Maybe a
Nothing,
		getMaybeRandomSeed :: Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
forall a. Maybe a
Nothing,
		getEvaluationOptions :: EvaluationOptions
getEvaluationOptions	= EvaluationOptions
forall a. Default a => a
Data.Default.def,
		getSearchOptions :: SearchOptions
getSearchOptions	= SearchOptions
forall a. Default a => a
Data.Default.def,
		getIOOptions :: IOOptions
getIOOptions		= IOOptions
forall a. Default a => a
Data.Default.def
	}

instance HXT.XmlPickler Options where
	xpickle :: PU Options
xpickle	= String -> PU Options -> PU Options
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU Options -> PU Options)
-> (PU
      (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
       IOOptions)
    -> PU Options)
-> PU
     (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
      IOOptions)
-> PU Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
  IOOptions)
 -> Options,
 Options
 -> (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
     IOOptions))
-> PU
     (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
      IOOptions)
-> PU Options
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Maybe NPlies
a, Maybe NPlies
b, EvaluationOptions
c, SearchOptions
d, IOOptions
e) -> Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions
-> SearchOptions
-> IOOptions
-> Options
mkOptions Maybe NPlies
a Maybe NPlies
b EvaluationOptions
c SearchOptions
d IOOptions
e,	-- Construct.
		\MkOptions {
			getMaybeMaximumPlies :: Options -> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
			getMaybeRandomSeed :: Options -> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
			getEvaluationOptions :: Options -> EvaluationOptions
getEvaluationOptions	= EvaluationOptions
evaluationOptions,
			getSearchOptions :: Options -> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
			getIOOptions :: Options -> IOOptions
getIOOptions		= IOOptions
ioOptions
		} -> (
			Maybe NPlies
maybeMaximumPlies,
			Maybe NPlies
maybeRandomSeed,
			EvaluationOptions
evaluationOptions,
			SearchOptions
searchOptions,
			IOOptions
ioOptions
		) -- Deconstruct.
	 ) (PU
   (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
    IOOptions)
 -> PU Options)
-> PU
     (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
      IOOptions)
-> PU Options
forall a b. (a -> b) -> a -> b
$ PU (Maybe NPlies)
-> PU (Maybe NPlies)
-> PU EvaluationOptions
-> PU SearchOptions
-> PU IOOptions
-> PU
     (Maybe NPlies, Maybe NPlies, EvaluationOptions, SearchOptions,
      IOOptions)
forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
HXT.xp5Tuple (
		String -> PU NPlies -> PU (Maybe NPlies)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
maximumPliesTag PU NPlies
forall a. XmlPickler a => PU a
HXT.xpickle {-NPlies-}
	 ) (
		String -> PU NPlies -> PU (Maybe NPlies)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
randomSeedTag PU NPlies
HXT.xpInt
	 ) PU EvaluationOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-EvaluationOptions-} PU SearchOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-SearchOptions-} PU IOOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-IOOptions-}

-- | Smart constructor.
mkOptions
	:: Maybe Type.Count.NPlies	-- ^ The maximum number of plies before the game is terminated; required for profiling the application.
	-> Maybe RandomSeed		-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.
	-> Input.EvaluationOptions.EvaluationOptions
	-> Input.SearchOptions.SearchOptions
	-> Input.IOOptions.IOOptions
	-> Options
mkOptions :: Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions
-> SearchOptions
-> IOOptions
-> Options
mkOptions Maybe NPlies
maybeMaximumPlies Maybe NPlies
maybeRandomSeed EvaluationOptions
evaluationOptions SearchOptions
searchOptions IOOptions
ioOptions
	| Just NPlies
maximumPlies	<- Maybe NPlies
maybeMaximumPlies
	, NPlies
maximumPlies NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
<= NPlies
0	= Exception -> Options
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Options)
-> (String -> Exception) -> String -> Options
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.Options.mkOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
maximumPliesTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> Options) -> String -> Options
forall a b. (a -> b) -> a -> b
$ NPlies -> ShowS
forall a. Show a => a -> ShowS
shows NPlies
maximumPlies String
" must exceed zero."
	| SearchOptions -> Bool
Input.SearchOptions.getSortOnStandardOpeningMoveFrequency SearchOptions
searchOptions Bool -> Bool -> Bool
&& [PGNOptions] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (
		IOOptions -> [PGNOptions]
Input.IOOptions.getPGNOptionsList IOOptions
ioOptions
	)			= Exception -> Options
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Options)
-> (String -> Exception) -> String -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.Options.mkOptions:\tcan't implement '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
Input.SearchOptions.tag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
Input.SearchOptions.sortOnStandardOpeningMoveFrequencyTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"' without any '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
Input.PGNOptions.tag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'.' (String -> Options) -> String -> Options
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
Input.PGNOptions.databaseFilePathTag String
"'"
	| Bool
otherwise	= MkOptions :: Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions
-> SearchOptions
-> IOOptions
-> Options
MkOptions {
		getMaybeMaximumPlies :: Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: EvaluationOptions
getEvaluationOptions	= EvaluationOptions
evaluationOptions,
		getSearchOptions :: SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: IOOptions
getIOOptions		= IOOptions
ioOptions
	}

-- | The type of a function used to transform 'Options'.
type Transformation	= Options -> Options

-- | Mutator.
setMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath -> Transformation
setMaybeOutputConfigFilePath :: Maybe String -> Transformation
setMaybeOutputConfigFilePath Maybe String
maybeOutputConfigFilePath options :: Options
options@MkOptions { getIOOptions :: Options -> IOOptions
getIOOptions	= IOOptions
ioOptions }	= Options
options {
	getIOOptions :: IOOptions
getIOOptions	= Maybe String -> Transformation
Input.IOOptions.setMaybeOutputConfigFilePath Maybe String
maybeOutputConfigFilePath IOOptions
ioOptions
}

-- | Mutator.
setMaybeRandomSeed :: Maybe RandomSeed -> Transformation
setMaybeRandomSeed :: Maybe NPlies -> Transformation
setMaybeRandomSeed Maybe NPlies
maybeRandomSeed Options
options	= Options
options {
	getMaybeRandomSeed :: Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed
}

-- | Mutator.
setMaybePersistence :: Maybe (System.FilePath.FilePath, Bool) -> Transformation
setMaybePersistence :: Maybe (String, Bool) -> Transformation
setMaybePersistence Maybe (String, Bool)
maybePersistence options :: Options
options@MkOptions { getIOOptions :: Options -> IOOptions
getIOOptions = IOOptions
ioOptions }	= Options
options {
	getIOOptions :: IOOptions
getIOOptions	= IOOptions
ioOptions {
		getMaybePersistence :: Maybe (String, Bool)
Input.IOOptions.getMaybePersistence	= Maybe (String, Bool)
maybePersistence
	}
}

-- | Mutator.
setVerbosity :: Input.Verbosity.Verbosity -> Transformation
setVerbosity :: Verbosity -> Transformation
setVerbosity Verbosity
verbosity options :: Options
options@MkOptions { getIOOptions :: Options -> IOOptions
getIOOptions = IOOptions
ioOptions }	= Options
options {
	getIOOptions :: IOOptions
getIOOptions	= Verbosity -> Transformation
Input.IOOptions.setVerbosity Verbosity
verbosity IOOptions
ioOptions
}

-- | Mutator.
setEitherNativeUIOrCECPOptions :: Input.UIOptions.EitherNativeUIOrCECPOptions -> Transformation
setEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions -> Transformation
setEitherNativeUIOrCECPOptions EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions options :: Options
options@MkOptions { getIOOptions :: Options -> IOOptions
getIOOptions = IOOptions
ioOptions }	= Options
options {
	getIOOptions :: IOOptions
getIOOptions	= EitherNativeUIOrCECPOptions -> Transformation
Input.IOOptions.setEitherNativeUIOrCECPOptions EitherNativeUIOrCECPOptions
eitherNativeUIOrCECPOptions IOOptions
ioOptions
}

-- | Mutator.
setMaybePrintMoveTree :: Maybe Property.Arboreal.Depth -> Transformation
setMaybePrintMoveTree :: Maybe NPlies -> Transformation
setMaybePrintMoveTree Maybe NPlies
maybePrintMoveTree options :: Options
options@MkOptions { getIOOptions :: Options -> IOOptions
getIOOptions = IOOptions
ioOptions }	= Options
options {
	getIOOptions :: IOOptions
getIOOptions	= Maybe NPlies -> Transformation
Input.IOOptions.setMaybePrintMoveTree Maybe NPlies
maybePrintMoveTree IOOptions
ioOptions
}

-- | Mutator.
swapSearchDepth :: Transformation
swapSearchDepth :: Transformation
swapSearchDepth options :: Options
options@MkOptions { getSearchOptions :: Options -> SearchOptions
getSearchOptions = SearchOptions
searchOptions }	= Options
options {
	getSearchOptions :: SearchOptions
getSearchOptions	= Transformation
Input.SearchOptions.swapSearchDepth SearchOptions
searchOptions
}