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

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

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Real	pieceSquareValue,
	Show	pieceSquareValue
 ) => Property.ShowFloat.ShowFloat (Options pieceSquareValue x y) where
	showsFloat :: (Double -> ShowS) -> Options pieceSquareValue x y -> ShowS
showsFloat Double -> ShowS
fromDouble MkOptions {
		getMaybeMaximumPlies :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: forall pieceSquareValue x y.
Options pieceSquareValue x y
-> EvaluationOptions pieceSquareValue x y
getEvaluationOptions	= EvaluationOptions pieceSquareValue x y
evaluationOptions,
		getSearchOptions :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> 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 pieceSquareValue x y -> ShowS
forall a. ShowFloat a => (Double -> ShowS) -> a -> ShowS
Property.ShowFloat.showsFloat Double -> ShowS
fromDouble EvaluationOptions pieceSquareValue x y
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 pieceSquareValue x y) where
	def :: Options pieceSquareValue x y
def = MkOptions :: forall pieceSquareValue x y.
Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions pieceSquareValue x y
-> SearchOptions
-> IOOptions
-> Options pieceSquareValue 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 pieceSquareValue x y
getEvaluationOptions	= EvaluationOptions pieceSquareValue x y
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 (
	Enum		x,
	Enum		y,
	Fractional	pieceSquareValue,
	Ord		pieceSquareValue,
	Ord		x,
	Ord		y,
	Real		pieceSquareValue,
	Show		pieceSquareValue
 ) => HXT.XmlPickler (Options pieceSquareValue x y) where
	xpickle :: PU (Options pieceSquareValue x y)
xpickle	= String
-> PU (Options pieceSquareValue x y)
-> PU (Options pieceSquareValue x y)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU (Options pieceSquareValue x y)
 -> PU (Options pieceSquareValue x y))
-> (PU
      (Maybe NPlies, Maybe NPlies,
       EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions)
    -> PU (Options pieceSquareValue x y))
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions)
-> PU (Options pieceSquareValue x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe NPlies, Maybe NPlies,
  EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions)
 -> Options pieceSquareValue x y,
 Options pieceSquareValue x y
 -> (Maybe NPlies, Maybe NPlies,
     EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions))
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions)
-> PU (Options pieceSquareValue x y)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Maybe NPlies
a, Maybe NPlies
b, EvaluationOptions pieceSquareValue x y
c, SearchOptions
d, IOOptions
e) -> Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions pieceSquareValue x y
-> SearchOptions
-> IOOptions
-> Options pieceSquareValue x y
forall pieceSquareValue x y.
Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions pieceSquareValue x y
-> SearchOptions
-> IOOptions
-> Options pieceSquareValue x y
mkOptions Maybe NPlies
a Maybe NPlies
b EvaluationOptions pieceSquareValue x y
c SearchOptions
d IOOptions
e,	-- Construct.
		\MkOptions {
			getMaybeMaximumPlies :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
			getMaybeRandomSeed :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
			getEvaluationOptions :: forall pieceSquareValue x y.
Options pieceSquareValue x y
-> EvaluationOptions pieceSquareValue x y
getEvaluationOptions	= EvaluationOptions pieceSquareValue x y
evaluationOptions,
			getSearchOptions :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
			getIOOptions :: forall pieceSquareValue x y.
Options pieceSquareValue x y -> IOOptions
getIOOptions		= IOOptions
ioOptions
		} -> (
			Maybe NPlies
maybeMaximumPlies,
			Maybe NPlies
maybeRandomSeed,
			EvaluationOptions pieceSquareValue x y
evaluationOptions,
			SearchOptions
searchOptions,
			IOOptions
ioOptions
		) -- Deconstruct.
	 ) (PU
   (Maybe NPlies, Maybe NPlies,
    EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions)
 -> PU (Options pieceSquareValue x y))
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions pieceSquareValue x y, SearchOptions, IOOptions)
-> PU (Options pieceSquareValue x y)
forall a b. (a -> b) -> a -> b
$ PU (Maybe NPlies)
-> PU (Maybe NPlies)
-> PU (EvaluationOptions pieceSquareValue x y)
-> PU SearchOptions
-> PU IOOptions
-> PU
     (Maybe NPlies, Maybe NPlies,
      EvaluationOptions pieceSquareValue x y, 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 pieceSquareValue x y)
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 pieceSquareValue x y
	-> Input.SearchOptions.SearchOptions
	-> Input.IOOptions.IOOptions
	-> Options pieceSquareValue x y
mkOptions :: Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions pieceSquareValue x y
-> SearchOptions
-> IOOptions
-> Options pieceSquareValue x y
mkOptions Maybe NPlies
maybeMaximumPlies Maybe NPlies
maybeRandomSeed EvaluationOptions pieceSquareValue x y
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 pieceSquareValue x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Options pieceSquareValue x y)
-> (String -> Exception) -> String -> Options pieceSquareValue 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 pieceSquareValue x y)
-> String -> Options pieceSquareValue 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 pieceSquareValue x y.
Maybe NPlies
-> Maybe NPlies
-> EvaluationOptions pieceSquareValue x y
-> SearchOptions
-> IOOptions
-> Options pieceSquareValue x y
MkOptions {
		getMaybeMaximumPlies :: Maybe NPlies
getMaybeMaximumPlies	= Maybe NPlies
maybeMaximumPlies,
		getMaybeRandomSeed :: Maybe NPlies
getMaybeRandomSeed	= Maybe NPlies
maybeRandomSeed,
		getEvaluationOptions :: EvaluationOptions pieceSquareValue x y
getEvaluationOptions	= EvaluationOptions pieceSquareValue x y
evaluationOptions,
		getSearchOptions :: SearchOptions
getSearchOptions	= SearchOptions
searchOptions,
		getIOOptions :: IOOptions
getIOOptions		= IOOptions
ioOptions
	}

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

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

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

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

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

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

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

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