{-
	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 [Chess-engine Communications-protocol](https://en.wikipedia.org/wiki/Chess_Engine_Communication_Protocol),
	as used by [XBoard](https://www.gnu.org/software/xboard/engine-intf.html)
-}

module BishBosh.Input.CECPOptions(
-- * Types
-- ** Type-synonyms
--	Mode,
--	ProtocolVersion,
--	Transformation,
-- ** Data-types
	CECPOptions(
--		MkCECPOptions,
		getAnalyseMode,
		getDisplaySAN,
		getEditMode,
		getForceMode,
		getMaybePaused,
		getPonderMode,
		getPostMode,
		getProtocolVersion,
		getCECPFeatures
	),
-- * Constants
	tag,
	analyseModeTag,
	displaySANTag,
	editModeTag,
	forceModeTag,
--	pausedTag,
	ponderModeTag,
	postModeTag,
	protocolVersionTag,
-- * Functions
	getNamedModes,
-- ** Constructors
	mkCECPOptions,
-- ** Mutators
	setProtocolVersion,
	updateFeature,
	deleteFeature,
	resetModes,
	pause,
	resume
) where

import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Input.CECPFeatures	as Input.CECPFeatures
import qualified	BishBosh.Property.Switchable	as Property.Switchable
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	BishBosh.Time.StopWatch		as Time.StopWatch
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Data.Maybe
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

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

-- | Used to qualify XML.
analyseModeTag :: String
analyseModeTag		= "analyseMode"

-- | Used to qualify XML.
displaySANTag :: String
displaySANTag		= "displaySAN"

-- | Used to qualify XML.
editModeTag :: String
editModeTag		= "editMode"

-- | Used to qualify XML.
forceModeTag :: String
forceModeTag		= "forceMode"

-- | Used to qualify XML.
pausedTag :: String
pausedTag		= "pause"

-- | Used to qualify XML.
ponderModeTag :: String
ponderModeTag		= "ponderMode"

-- | Used to qualify XML.
postModeTag :: String
postModeTag		= "postMode"

-- | Used to qualify XML.
protocolVersionTag :: String
protocolVersionTag	= "protocolVersion"

-- | Self-documentation.
type Mode	= Bool

-- | Self-documentation.
type ProtocolVersion	= Int

-- | Defines options related to CECP.
data CECPOptions	= MkCECPOptions {
	getAnalyseMode		:: Mode,				-- ^ TODO.
	getDisplaySAN		:: Bool,				-- ^ Whether to display moves in SAN or 'Input.UIOptions.getMoveNotation'.
	getEditMode		:: Mode,				-- ^ Whether the game should be placed in set-up mode.
	getForceMode		:: Mode,				-- ^ Neither player's moves are automated, allowing an arbitrary game to be configured.
	getMaybePaused		:: Maybe Time.StopWatch.StopWatch,	-- ^ Whether the engine was paused & a paused watch.
	getPonderMode		:: Mode,				-- ^ Whether to keep thinking while it's one's opponent's turn.
	getPostMode		:: Mode,				-- ^ Whether to show the details of deliberations.
	getProtocolVersion	:: ProtocolVersion,			-- ^ The version of the CECP-protocol to use.
	getCECPFeatures		:: Input.CECPFeatures.CECPFeatures
} deriving Eq

instance Control.DeepSeq.NFData CECPOptions where
	rnf MkCECPOptions {
		getAnalyseMode		= analyseMode,
		getDisplaySAN		= displaySAN,
		getEditMode		= editMode,
		getForceMode		= forceMode,
		getMaybePaused		= maybePaused,
		getPonderMode		= ponderMode,
		getPostMode		= postMode,
		getProtocolVersion	= protocolVersion,
		getCECPFeatures		= cecpFeatures
	} = Control.DeepSeq.rnf (analyseMode, displaySAN, editMode, forceMode, maybePaused, ponderMode, postMode, protocolVersion, cecpFeatures)

instance Show CECPOptions where
	showsPrec _ MkCECPOptions {
		getAnalyseMode		= analyseMode,
		getDisplaySAN		= displaySAN,
		getEditMode		= editMode,
		getForceMode		= forceMode,
		getMaybePaused		= maybePaused,
		getPonderMode		= ponderMode,
		getPostMode		= postMode,
		getProtocolVersion	= protocolVersion,
		getCECPFeatures		= cecpFeatures
	} = Text.ShowList.showsAssociationList' [
		(
			analyseModeTag,
			shows analyseMode
		), (
			displaySANTag,
			shows displaySAN
		), (
			editModeTag,
			shows editMode
		), (
			forceModeTag,
			shows forceMode
		), (
			pausedTag,
			shows maybePaused
		), (
			ponderModeTag,
			shows ponderMode
		), (
			postModeTag,
			shows postMode
		), (
			protocolVersionTag,
			shows protocolVersion
		), (
			Input.CECPFeatures.tag,
			showChar '{' . shows cecpFeatures . showChar '}'
		)
	 ]

instance Data.Default.Default CECPOptions where
	def = MkCECPOptions {
		getAnalyseMode		= False,
		getEditMode		= False,
		getDisplaySAN		= True,
		getForceMode		= False,
		getMaybePaused		= Nothing,
		getPonderMode		= False,
		getPostMode		= False,
		getProtocolVersion	= 1,
		getCECPFeatures		= Data.Default.def
	}

instance HXT.XmlPickler CECPOptions where
	xpickle	= HXT.xpElem tag . HXT.xpWrap (
		\(a, b, c, d, e, f, g, h) -> mkCECPOptions a b c d (getMaybePaused def) e f g h,	-- Construct.
		\MkCECPOptions {
			getAnalyseMode		= analyseMode,
			getDisplaySAN		= displaySAN,
			getEditMode		= editMode,
			getForceMode		= forceMode,
			getPonderMode		= ponderMode,
			getPostMode		= postMode,
			getProtocolVersion	= protocolVersion,
			getCECPFeatures		= cecpFeatures
		} -> (analyseMode, displaySAN, editMode, forceMode, ponderMode, postMode, protocolVersion, cecpFeatures) -- Deconstruct.
	 ) $ HXT.xp8Tuple (
		getAnalyseMode def `HXT.xpDefault` HXT.xpAttr analyseModeTag HXT.xpickle
	 ) (
		getDisplaySAN def `HXT.xpDefault` HXT.xpAttr displaySANTag HXT.xpickle
	 ) (
		getEditMode def `HXT.xpDefault` HXT.xpAttr editModeTag HXT.xpickle
	 ) (
		getForceMode def `HXT.xpDefault` HXT.xpAttr forceModeTag HXT.xpickle
	 ) (
		getPonderMode def `HXT.xpDefault` HXT.xpAttr ponderModeTag HXT.xpickle
	 ) (
		getPostMode def `HXT.xpDefault` HXT.xpAttr postModeTag HXT.xpickle
	 ) (
		getProtocolVersion def `HXT.xpDefault` HXT.xpAttr protocolVersionTag HXT.xpickle
	 ) HXT.xpickle {-CECPFeatures-} where
		def	= Data.Default.def

-- | Smart constructor.
mkCECPOptions
	:: Mode					-- ^ Analyse-mode.
	-> Bool					-- ^ Display SAN.
	-> Mode					-- ^ Edit-mode.
	-> Mode					-- ^ Force-mode.
	-> Maybe Time.StopWatch.StopWatch	-- ^ Paused.
	-> Mode					-- ^ Ponder-mode.
	-> Mode					-- ^ Post-mode.
	-> ProtocolVersion
	-> Input.CECPFeatures.CECPFeatures
	-> CECPOptions
mkCECPOptions analyseMode displaySAN editMode forceMode maybePaused ponderMode postMode protocolVersion cecpFeatures
	| protocolVersion < 1	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.UI.CECPOptions.mkCECPOptions:\t" $ shows protocolVersionTag " must exceed zero."
	| otherwise		= MkCECPOptions {
		getAnalyseMode		= analyseMode,
		getDisplaySAN		= displaySAN,
		getEditMode		= editMode,
		getForceMode		= forceMode,
		getMaybePaused		= maybePaused,
		getPonderMode		= ponderMode,
		getPostMode		= postMode,
		getProtocolVersion	= protocolVersion,
		getCECPFeatures		= cecpFeatures
	}

-- | Self-documentation.
type Transformation	= CECPOptions -> CECPOptions

-- | Mutator.
setProtocolVersion :: ProtocolVersion -> Transformation
setProtocolVersion protocolVersion cecpOptions
	| protocolVersion < 1	= Control.Exception.throw $ Data.Exception.mkOutOfBounds . showString "BishBosh.UI.CECPOptions.setProtocolVersion:\t" $ shows protocolVersion " must exceed zero."
	| otherwise		= cecpOptions {
		getProtocolVersion	= protocolVersion
	}

-- | Mutator.
updateFeature :: Input.CECPFeatures.Feature -> Transformation
updateFeature feature cecpOptions@MkCECPOptions { getCECPFeatures = cecpFeatures }	= cecpOptions {
	getCECPFeatures	= Input.CECPFeatures.updateFeature feature cecpFeatures
}

-- | Mutator.
deleteFeature :: Input.CECPFeatures.Feature -> Transformation
deleteFeature feature cecpOptions@MkCECPOptions { getCECPFeatures = cecpFeatures }	= cecpOptions {
	getCECPFeatures	= Input.CECPFeatures.deleteFeature feature cecpFeatures
}

-- | Reset all modes but leave the remaining fields unaltered.
resetModes :: Transformation
resetModes cecpOptions	= cecpOptions {
	getAnalyseMode	= False,
	getEditMode	= False,
	getForceMode	= False,
	getMaybePaused	= Nothing,
	getPonderMode	= False,
	getPostMode	= False
}

-- | Get an association-list of named modes.
getNamedModes :: CECPOptions -> [(String, Mode)]
getNamedModes MkCECPOptions {
	getAnalyseMode	= analyseMode,
	getEditMode	= editMode,
	getForceMode	= forceMode,
	getMaybePaused	= maybePaused,
	getPonderMode	= ponderMode,
	getPostMode	= postMode
} = [
	(
		analyseModeTag,
		analyseMode
	), (
		editModeTag,
		editMode
	), (
		forceModeTag,
		forceMode
	), (
		pausedTag,
		Data.Maybe.isJust maybePaused
	), (
		ponderModeTag,
		ponderMode
	), (
		postModeTag,
		postMode
	)
 ]

-- | Mutator.
pause :: Time.StopWatch.StopWatch -> CECPOptions -> CECPOptions
pause _ MkCECPOptions { getMaybePaused = Just _ }	= Control.Exception.throw $ Data.Exception.mkRequestFailure "BishBosh.Input.CECPOptions.pause:\talready paused."
pause stopWatch cecpOptions
	| Property.Switchable.isOn stopWatch	= Control.Exception.throw $ Data.Exception.mkRequestFailure "BishBosh.Input.CECPOptions.pause:\tthe stop-watch is still running."
	| otherwise				= cecpOptions { getMaybePaused = Just stopWatch }

-- | Mutator.
resume :: CECPOptions -> CECPOptions
resume MkCECPOptions { getMaybePaused = Nothing }	= Control.Exception.throw $ Data.Exception.mkRequestFailure "BishBosh.Input.CECPOptions.resume:\talready resumed."
resume cecpOptions					= cecpOptions { getMaybePaused = Nothing }