{-
	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			BishBosh.Data.Integral()	-- For 'HXT.XmlPickler NMoves'.
import qualified	BishBosh.Component.Move			as Component.Move
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.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	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 column criterionWeight pieceSquareValue rankValue row x y	= MkOptions {
	Options column criterionWeight pieceSquareValue rankValue row x y
-> Maybe NPlies
getMaybeMaximumPlies	:: Maybe Component.Move.NPlies,									-- ^ The maximum number of plies before the game is terminated; required for profiling the application.
	Options column criterionWeight pieceSquareValue rankValue row x y
-> Maybe NPlies
getMaybeRandomSeed	:: Maybe RandomSeed,										-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.
	Options column criterionWeight pieceSquareValue rankValue row x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
getEvaluationOptions	:: Input.EvaluationOptions.EvaluationOptions criterionWeight pieceSquareValue rankValue x y,	-- ^ The single set of options by which all automated /move/s are evaluated.
	Options column criterionWeight pieceSquareValue rankValue row x y
-> SearchOptions
getSearchOptions	:: Input.SearchOptions.SearchOptions,								-- ^ The options by which to automatically select /move/s.
	Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions		:: Input.IOOptions.IOOptions row column								-- ^ The /ioOptions/ by which to receive commands & present results.
} deriving (Options column criterionWeight pieceSquareValue rankValue row x y
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> Bool
(Options column criterionWeight pieceSquareValue rankValue row x y
 -> Options
      column criterionWeight pieceSquareValue rankValue row x y
 -> Bool)
-> (Options
      column criterionWeight pieceSquareValue rankValue row x y
    -> Options
         column criterionWeight pieceSquareValue rankValue row x y
    -> Bool)
-> Eq
     (Options column criterionWeight pieceSquareValue rankValue row x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Eq rankValue, Eq criterionWeight,
 Eq pieceSquareValue, Eq row, Eq column) =>
Options column criterionWeight pieceSquareValue rankValue row x y
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> Bool
/= :: Options column criterionWeight pieceSquareValue rankValue row x y
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> Bool
$c/= :: forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Eq rankValue, Eq criterionWeight,
 Eq pieceSquareValue, Eq row, Eq column) =>
Options column criterionWeight pieceSquareValue rankValue row x y
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> Bool
== :: Options column criterionWeight pieceSquareValue rankValue row x y
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> Bool
$c== :: forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Eq rankValue, Eq criterionWeight,
 Eq pieceSquareValue, Eq row, Eq column) =>
Options column criterionWeight pieceSquareValue rankValue row x y
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> Bool
Eq, NPlies
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> ShowS
[Options column criterionWeight pieceSquareValue rankValue row x y]
-> ShowS
Options column criterionWeight pieceSquareValue rankValue row x y
-> String
(NPlies
 -> Options
      column criterionWeight pieceSquareValue rankValue row x y
 -> ShowS)
-> (Options
      column criterionWeight pieceSquareValue rankValue row x y
    -> String)
-> ([Options
       column criterionWeight pieceSquareValue rankValue row x y]
    -> ShowS)
-> Show
     (Options column criterionWeight pieceSquareValue rankValue row x y)
forall a.
(NPlies -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue,
 Show column, Show row) =>
NPlies
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> ShowS
forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue,
 Show column, Show row) =>
[Options column criterionWeight pieceSquareValue rankValue row x y]
-> ShowS
forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue,
 Show column, Show row) =>
Options column criterionWeight pieceSquareValue rankValue row x y
-> String
showList :: [Options column criterionWeight pieceSquareValue rankValue row x y]
-> ShowS
$cshowList :: forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue,
 Show column, Show row) =>
[Options column criterionWeight pieceSquareValue rankValue row x y]
-> ShowS
show :: Options column criterionWeight pieceSquareValue rankValue row x y
-> String
$cshow :: forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue,
 Show column, Show row) =>
Options column criterionWeight pieceSquareValue rankValue row x y
-> String
showsPrec :: NPlies
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> ShowS
$cshowsPrec :: forall column criterionWeight pieceSquareValue rankValue row x y.
(Enum x, Enum y, Ord x, Ord y, Show rankValue,
 Show criterionWeight, Show x, Show y, Show pieceSquareValue,
 Show column, Show row) =>
NPlies
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> ShowS
Show)

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

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Real	criterionWeight,
	Real	pieceSquareValue,
	Real	rankValue,
	Show	column,
	Show	pieceSquareValue,
	Show	row
 ) => Property.ShowFloat.ShowFloat (Options column criterionWeight pieceSquareValue rankValue row x y) where
	showsFloat :: (Double -> ShowS)
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
-> ShowS
showsFloat Double -> ShowS
fromDouble MkOptions {
		getMaybeMaximumPlies :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
getEvaluationOptions	= EvaluationOptions criterionWeight pieceSquareValue rankValue x y
evaluationOptions,
		getSearchOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions		= IOOptions row column
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 criterionWeight pieceSquareValue rankValue x y
-> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble EvaluationOptions criterionWeight pieceSquareValue rankValue x y
evaluationOptions
		), (
			String
Input.SearchOptions.tag,
			SearchOptions -> ShowS
forall a. Show a => a -> ShowS
shows SearchOptions
searchOptions
		), (
			String
Input.IOOptions.tag,
			IOOptions row column -> ShowS
forall a. Show a => a -> ShowS
shows IOOptions row column
ioOptions
		)
	 ]

instance (
	Fractional	rankValue,
	Num		criterionWeight,
	Num		column,
	Num		row,
	Ord		rankValue,
	Show		rankValue
 ) => Data.Default.Default (Options column criterionWeight pieceSquareValue rankValue row x y) where
	def :: Options column criterionWeight pieceSquareValue rankValue row x y
def = MkOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> SearchOptions
-> IOOptions row column
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
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 criterionWeight pieceSquareValue rankValue x y
getEvaluationOptions	= EvaluationOptions criterionWeight pieceSquareValue rankValue x y
forall a. Default a => a
Data.Default.def,
		getSearchOptions :: SearchOptions
getSearchOptions	= SearchOptions
forall a. Default a => a
Data.Default.def,
		getIOOptions :: IOOptions row column
getIOOptions		= IOOptions row column
forall a. Default a => a
Data.Default.def
	}

instance (
	Enum		x,
	Enum		y,
	Fractional	pieceSquareValue,
	Fractional	rankValue,
	HXT.XmlPickler	column,
	HXT.XmlPickler	criterionWeight,
	HXT.XmlPickler	rankValue,
	HXT.XmlPickler	row,
	Integral	column,
	Integral	row,
	Num		criterionWeight,
	Ord		pieceSquareValue,
	Ord		rankValue,
	Ord		x,
	Ord		y,
	Real		criterionWeight,
	Real		pieceSquareValue,
	Show		column,
	Show		criterionWeight,
	Show		pieceSquareValue,
	Show		rankValue,
	Show		row
 ) => HXT.XmlPickler (Options column criterionWeight pieceSquareValue rankValue row x y) where
	xpickle :: PU
  (Options column criterionWeight pieceSquareValue rankValue row x y)
xpickle	= String
-> PU
     (Options column criterionWeight pieceSquareValue rankValue row x y)
-> PU
     (Options column criterionWeight pieceSquareValue rankValue row x y)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU
   (Options column criterionWeight pieceSquareValue rankValue row x y)
 -> PU
      (Options
         column criterionWeight pieceSquareValue rankValue row x y))
-> (PU
      (Maybe NPlies, Maybe NPlies,
       EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
       SearchOptions, IOOptions row column)
    -> PU
         (Options
            column criterionWeight pieceSquareValue rankValue row x y))
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
      SearchOptions, IOOptions row column)
-> PU
     (Options column criterionWeight pieceSquareValue rankValue row x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe NPlies, Maybe NPlies,
  EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
  SearchOptions, IOOptions row column)
 -> Options
      column criterionWeight pieceSquareValue rankValue row x y,
 Options column criterionWeight pieceSquareValue rankValue row x y
 -> (Maybe NPlies, Maybe NPlies,
     EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
     SearchOptions, IOOptions row column))
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
      SearchOptions, IOOptions row column)
-> PU
     (Options column criterionWeight pieceSquareValue rankValue row x y)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Maybe NPlies
a, Maybe NPlies
b, EvaluationOptions criterionWeight pieceSquareValue rankValue x y
c, SearchOptions
d, IOOptions row column
e) -> Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> SearchOptions
-> IOOptions row column
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
forall criterionWeight pieceSquareValue rankValue x y row column.
Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> SearchOptions
-> IOOptions row column
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
mkOptions Maybe NPlies
a Maybe NPlies
b EvaluationOptions criterionWeight pieceSquareValue rankValue x y
c SearchOptions
d IOOptions row column
e,	-- Construct.
		\MkOptions {
			getMaybeMaximumPlies :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
			getMaybeRandomSeed :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
			getEvaluationOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
getEvaluationOptions	= EvaluationOptions criterionWeight pieceSquareValue rankValue x y
evaluationOptions,
			getSearchOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
			getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions		= IOOptions row column
ioOptions
		} -> (
			Maybe NPlies
maybeMaximumPlies,
			Maybe NPlies
maybeRandomSeed,
			EvaluationOptions criterionWeight pieceSquareValue rankValue x y
evaluationOptions,
			SearchOptions
searchOptions,
			IOOptions row column
ioOptions
		) -- Deconstruct.
	 ) (PU
   (Maybe NPlies, Maybe NPlies,
    EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
    SearchOptions, IOOptions row column)
 -> PU
      (Options
         column criterionWeight pieceSquareValue rankValue row x y))
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
      SearchOptions, IOOptions row column)
-> PU
     (Options column criterionWeight pieceSquareValue rankValue row x y)
forall a b. (a -> b) -> a -> b
$ PU (Maybe NPlies)
-> PU (Maybe NPlies)
-> PU
     (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
-> PU SearchOptions
-> PU (IOOptions row column)
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions criterionWeight pieceSquareValue rankValue x y,
      SearchOptions, IOOptions row column)
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
HXT.xpInt {-NMoves-}
	 ) (
		String -> PU NPlies -> PU (Maybe NPlies)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
randomSeedTag PU NPlies
HXT.xpInt
	 ) PU
  (EvaluationOptions criterionWeight pieceSquareValue rankValue x y)
forall a. XmlPickler a => PU a
HXT.xpickle {-EvaluationOptions-} PU SearchOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-SearchOptions-} PU (IOOptions row column)
forall a. XmlPickler a => PU a
HXT.xpickle {-IOOptions-}

-- | Smart constructor.
mkOptions
	:: Maybe Component.Move.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 criterionWeight pieceSquareValue rankValue x y
	-> Input.SearchOptions.SearchOptions
	-> Input.IOOptions.IOOptions row column
	-> Options column criterionWeight pieceSquareValue rankValue row x y
mkOptions :: Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> SearchOptions
-> IOOptions row column
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
mkOptions Maybe NPlies
maybeMaximumPlies Maybe NPlies
maybeRandomSeed EvaluationOptions criterionWeight pieceSquareValue rankValue x y
evaluationOptions SearchOptions
searchOptions IOOptions row column
ioOptions
	| Just NPlies
maximumPlies	<- Maybe NPlies
maybeMaximumPlies
	, NPlies
maximumPlies NPlies -> NPlies -> Bool
forall a. Ord a => a -> a -> Bool
<= NPlies
0	= Exception
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception
 -> Options
      column criterionWeight pieceSquareValue rankValue row x y)
-> (String -> Exception)
-> String
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
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
      column criterionWeight pieceSquareValue rankValue row x y)
-> String
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
forall a b. (a -> b) -> a -> b
$ NPlies -> ShowS
forall a. Show a => a -> ShowS
shows NPlies
maximumPlies String
" must exceed zero."
	| Bool
otherwise	= MkOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions criterionWeight pieceSquareValue rankValue x y
-> SearchOptions
-> IOOptions row column
-> Options
     column criterionWeight pieceSquareValue rankValue row x y
MkOptions {
		getMaybeMaximumPlies :: Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: EvaluationOptions criterionWeight pieceSquareValue rankValue x y
getEvaluationOptions	= EvaluationOptions criterionWeight pieceSquareValue rankValue x y
evaluationOptions,
		getSearchOptions :: SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: IOOptions row column
getIOOptions		= IOOptions row column
ioOptions
	}

-- | The type of a function used to transform 'Options'.
type Transformation column criterionWeight pieceSquareValue rankValue row x y	= Options column criterionWeight pieceSquareValue rankValue row x y -> Options column criterionWeight pieceSquareValue rankValue row x y

-- | Mutator.
setMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath -> Transformation column criterionWeight pieceSquareValue rankValue row x y
setMaybeOutputConfigFilePath :: Maybe String
-> Transformation
     column criterionWeight pieceSquareValue rankValue row x y
setMaybeOutputConfigFilePath Maybe String
maybeOutputConfigFilePath options :: Options column criterionWeight pieceSquareValue rankValue row x y
options@MkOptions { getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions	= IOOptions row column
ioOptions }	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getIOOptions :: IOOptions row column
getIOOptions	= Maybe String -> Transformation row column
forall row column. Maybe String -> Transformation row column
Input.IOOptions.setMaybeOutputConfigFilePath Maybe String
maybeOutputConfigFilePath IOOptions row column
ioOptions
}

-- | Mutator.
setMaybeRandomSeed :: Maybe RandomSeed -> Transformation column criterionWeight pieceSquareValue rankValue row x y
setMaybeRandomSeed :: Maybe NPlies
-> Transformation
     column criterionWeight pieceSquareValue rankValue row x y
setMaybeRandomSeed Maybe NPlies
maybeRandomSeed Options column criterionWeight pieceSquareValue rankValue row x y
options	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getMaybeRandomSeed :: Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed
}

-- | Mutator.
setMaybePersistence :: Maybe (System.FilePath.FilePath, Bool) -> Transformation column criterionWeight pieceSquareValue rankValue row x y
setMaybePersistence :: Maybe (String, Bool)
-> Transformation
     column criterionWeight pieceSquareValue rankValue row x y
setMaybePersistence Maybe (String, Bool)
maybePersistence options :: Options column criterionWeight pieceSquareValue rankValue row x y
options@MkOptions { getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions = IOOptions row column
ioOptions }	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getIOOptions :: IOOptions row column
getIOOptions	= IOOptions row column
ioOptions {
		getMaybePersistence :: Maybe (String, Bool)
Input.IOOptions.getMaybePersistence	= Maybe (String, Bool)
maybePersistence
	}
}

-- | Mutator.
setVerbosity :: Input.Verbosity.Verbosity -> Transformation column criterionWeight pieceSquareValue rankValue row x y
setVerbosity :: Verbosity
-> Transformation
     column criterionWeight pieceSquareValue rankValue row x y
setVerbosity Verbosity
verbosity options :: Options column criterionWeight pieceSquareValue rankValue row x y
options@MkOptions { getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions = IOOptions row column
ioOptions }	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getIOOptions :: IOOptions row column
getIOOptions	= Verbosity -> Transformation row column
forall row column. Verbosity -> Transformation row column
Input.IOOptions.setVerbosity Verbosity
verbosity IOOptions row column
ioOptions
}

-- | Mutator.
setEitherNativeUIOrCECPOptions :: Input.UIOptions.EitherNativeUIOrCECPOptions row column -> Transformation column criterionWeight pieceSquareValue rankValue row x y
setEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column
-> Transformation
     column criterionWeight pieceSquareValue rankValue row x y
setEitherNativeUIOrCECPOptions EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions options :: Options column criterionWeight pieceSquareValue rankValue row x y
options@MkOptions { getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions = IOOptions row column
ioOptions }	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getIOOptions :: IOOptions row column
getIOOptions	= EitherNativeUIOrCECPOptions row column -> Transformation row column
forall row column.
EitherNativeUIOrCECPOptions row column -> Transformation row column
Input.IOOptions.setEitherNativeUIOrCECPOptions EitherNativeUIOrCECPOptions row column
eitherNativeUIOrCECPOptions IOOptions row column
ioOptions
}

-- | Mutator.
setMaybePrintMoveTree :: Maybe Property.Arboreal.Depth -> Transformation column criterionWeight pieceSquareValue rankValue row x y
setMaybePrintMoveTree :: Maybe NPlies
-> Transformation
     column criterionWeight pieceSquareValue rankValue row x y
setMaybePrintMoveTree Maybe NPlies
maybePrintMoveTree options :: Options column criterionWeight pieceSquareValue rankValue row x y
options@MkOptions { getIOOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> IOOptions row column
getIOOptions = IOOptions row column
ioOptions }	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getIOOptions :: IOOptions row column
getIOOptions	= Maybe NPlies -> Transformation row column
forall row column. Maybe NPlies -> Transformation row column
Input.IOOptions.setMaybePrintMoveTree Maybe NPlies
maybePrintMoveTree IOOptions row column
ioOptions
}

-- | Mutator.
swapSearchDepth :: Transformation column criterionWeight pieceSquareValue rankValue row x y
swapSearchDepth :: Transformation
  column criterionWeight pieceSquareValue rankValue row x y
swapSearchDepth options :: Options column criterionWeight pieceSquareValue rankValue row x y
options@MkOptions { getSearchOptions :: forall column criterionWeight pieceSquareValue rankValue row x y.
Options column criterionWeight pieceSquareValue rankValue row x y
-> SearchOptions
getSearchOptions = SearchOptions
searchOptions }	= Options column criterionWeight pieceSquareValue rankValue row x y
options {
	getSearchOptions :: SearchOptions
getSearchOptions	= Transformation
Input.SearchOptions.swapSearchDepth SearchOptions
searchOptions
}