packages feed

bishbosh-0.1.2.0: src-lib/BishBosh/Input/Options.hs

{-
	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			= "options"

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

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

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

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

instance Control.DeepSeq.NFData pieceSquareValue => Control.DeepSeq.NFData (Options pieceSquareValue) where
	rnf MkOptions {
		getMaybeMaximumPlies	= maybeMaximumPlies,
		getMaybeRandomSeed	= maybeRandomSeed,
		getEvaluationOptions	= evaluationOptions,
		getSearchOptions	= searchOptions,
		getIOOptions		= ioOptions
	} = Control.DeepSeq.rnf (maybeMaximumPlies, maybeRandomSeed, evaluationOptions, searchOptions, ioOptions)

instance (Real pieceSquareValue, Show pieceSquareValue) => Property.ShowFloat.ShowFloat (Options pieceSquareValue) where
	showsFloat fromDouble MkOptions {
		getMaybeMaximumPlies	= maybeMaximumPlies,
		getMaybeRandomSeed	= maybeRandomSeed,
		getEvaluationOptions	= evaluationOptions,
		getSearchOptions	= searchOptions,
		getIOOptions		= ioOptions
	} = Text.ShowList.showsAssociationList' . Data.Maybe.maybe id (
		(:) . (,) maximumPliesTag . shows
	 ) maybeMaximumPlies $ Data.Maybe.maybe id (
		(:) . (,) randomSeedTag . shows
	 ) maybeRandomSeed [
		(
			Input.EvaluationOptions.tag,
			Property.ShowFloat.showsFloat fromDouble evaluationOptions
		), (
			Input.SearchOptions.tag,
			shows searchOptions
		), (
			Input.IOOptions.tag,
			shows ioOptions
		)
	 ]

instance Data.Default.Default (Options pieceSquareValue) where
	def = MkOptions {
		getMaybeMaximumPlies	= Nothing,
		getMaybeRandomSeed	= Nothing,
		getEvaluationOptions	= Data.Default.def,
		getSearchOptions	= Data.Default.def,
		getIOOptions		= Data.Default.def
	}

instance (
	Fractional	pieceSquareValue,
	Ord		pieceSquareValue,
	Real		pieceSquareValue,
	Show		pieceSquareValue
 ) => HXT.XmlPickler (Options pieceSquareValue) where
	xpickle	= HXT.xpElem tag . HXT.xpWrap (
		\(a, b, c, d, e) -> mkOptions a b c d e,	-- Construct.
		\MkOptions {
			getMaybeMaximumPlies	= maybeMaximumPlies,
			getMaybeRandomSeed	= maybeRandomSeed,
			getEvaluationOptions	= evaluationOptions,
			getSearchOptions	= searchOptions,
			getIOOptions		= ioOptions
		} -> (
			maybeMaximumPlies,
			maybeRandomSeed,
			evaluationOptions,
			searchOptions,
			ioOptions
		) -- Deconstruct.
	 ) $ HXT.xp5Tuple (
		HXT.xpAttrImplied maximumPliesTag HXT.xpickle {-NPlies-}
	 ) (
		HXT.xpAttrImplied randomSeedTag HXT.xpInt
	 ) HXT.xpickle {-EvaluationOptions-} HXT.xpickle {-SearchOptions-} 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
	-> Input.SearchOptions.SearchOptions
	-> Input.IOOptions.IOOptions
	-> Options pieceSquareValue
mkOptions maybeMaximumPlies maybeRandomSeed evaluationOptions searchOptions ioOptions
	| Just maximumPlies	<- maybeMaximumPlies
	, maximumPlies <= 0	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.Options.mkOptions:\t" . showString maximumPliesTag . Text.ShowList.showsAssociation $ shows maximumPlies " must exceed zero."
	| Input.SearchOptions.getSortOnStandardOpeningMoveFrequency searchOptions && null (
		Input.IOOptions.getPGNOptionsList ioOptions
	)			= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.Options.mkOptions:\tcan't implement '" . showString Input.SearchOptions.tag . showChar '.' . showString Input.SearchOptions.sortOnStandardOpeningMoveFrequencyTag . showString "' without any '" . showString Input.PGNOptions.tag . showChar '.' $ showString Input.PGNOptions.databaseFilePathTag "'"
	| otherwise	= MkOptions {
		getMaybeMaximumPlies	= maybeMaximumPlies,
		getMaybeRandomSeed	= maybeRandomSeed,
		getEvaluationOptions	= evaluationOptions,
		getSearchOptions	= searchOptions,
		getIOOptions		= ioOptions
	}

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

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

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

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

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

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

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

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