{-
	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 related to the process of searching standard-openings.
-}

module BishBosh.Input.StandardOpeningOptions(
-- * Types
-- ** Type-synonyms
--	TryToMatchMoves,
--	TryToMatchViaJoiningMove,
--	TryToMatchColourFlippedPosition,
	MatchSwitches,
-- ** Data-types
	StandardOpeningOptions(
--		MkStandardOpeningOptions,
--		getTryToMatchMoves,
--		getTryToMatchViaJoiningMove,
--		getTryToMatchColourFlippedPosition
	),
-- * Constants
	tag,
--	tryToMatchMovesTag,
--	tryToMatchViaJoiningMoveTag,
--	tryToMatchColourFlippedPositionTag,
-- * Functions
-- ** Constructor
	mkStandardOpeningOptions,
-- ** Accessors
	getMatchSwitches
) where

import			BishBosh.Data.Bool()		-- For 'HXT.xpickle'.
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	Control.DeepSeq
import qualified	Data.Default
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

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

-- | Used to qualify XML.
tryToMatchMovesTag :: String
tryToMatchMovesTag :: String
tryToMatchMovesTag			= String
"tryToMatchMoves"

-- | Used to qualify XML.
tryToMatchViaJoiningMoveTag :: String
tryToMatchViaJoiningMoveTag :: String
tryToMatchViaJoiningMoveTag		= String
"tryToMatchViaJoiningMove"

-- | Used to qualify XML.
tryToMatchColourFlippedPositionTag :: String
tryToMatchColourFlippedPositionTag :: String
tryToMatchColourFlippedPositionTag	= String
"tryToMatchColourFlippedPosition"

-- | Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched.
type TryToMatchMoves	= Bool

-- | Whether to attempt to join the current position to a standard opening that's only one ply away.
type TryToMatchViaJoiningMove	= Bool

-- | Whether to attempt to match a colour-flipped version of the current position with a standard opening
type TryToMatchColourFlippedPosition	= Bool

-- | The switches used to control attempts to find a match amongst standard openings.
type MatchSwitches	= (TryToMatchMoves, TryToMatchViaJoiningMove, TryToMatchColourFlippedPosition)

-- | Defines options related to searching for a move.
data StandardOpeningOptions	= MkStandardOpeningOptions {
	StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			:: TryToMatchMoves,			-- ^ Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched.
	StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		:: TryToMatchViaJoiningMove,		-- ^ Whether to attempt to join the current position to a standard opening that's only one ply away.
	StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	:: TryToMatchColourFlippedPosition	-- ^ Whether to attempt to match a colour-flipped version of the current position with a standard opening.
} deriving StandardOpeningOptions -> StandardOpeningOptions -> TryToMatchMoves
(StandardOpeningOptions
 -> StandardOpeningOptions -> TryToMatchMoves)
-> (StandardOpeningOptions
    -> StandardOpeningOptions -> TryToMatchMoves)
-> Eq StandardOpeningOptions
forall a.
(a -> a -> TryToMatchMoves) -> (a -> a -> TryToMatchMoves) -> Eq a
/= :: StandardOpeningOptions -> StandardOpeningOptions -> TryToMatchMoves
$c/= :: StandardOpeningOptions -> StandardOpeningOptions -> TryToMatchMoves
== :: StandardOpeningOptions -> StandardOpeningOptions -> TryToMatchMoves
$c== :: StandardOpeningOptions -> StandardOpeningOptions -> TryToMatchMoves
Eq

instance Control.DeepSeq.NFData StandardOpeningOptions where
	rnf :: StandardOpeningOptions -> ()
rnf MkStandardOpeningOptions {
		getTryToMatchMoves :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
		getTryToMatchViaJoiningMove :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
		getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition
	} = (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (TryToMatchMoves
tryToMatchMoves, TryToMatchMoves
tryToMatchViaJoiningMove, TryToMatchMoves
tryToMatchColourFlippedPosition)

instance Show StandardOpeningOptions where
	showsPrec :: Int -> StandardOpeningOptions -> ShowS
showsPrec Int
_ MkStandardOpeningOptions {
		getTryToMatchMoves :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
		getTryToMatchViaJoiningMove :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
		getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' [
		(
			String
tryToMatchMovesTag,
			TryToMatchMoves -> ShowS
forall a. Show a => a -> ShowS
shows TryToMatchMoves
tryToMatchMoves
		), (
			String
tryToMatchViaJoiningMoveTag,
			TryToMatchMoves -> ShowS
forall a. Show a => a -> ShowS
shows TryToMatchMoves
tryToMatchViaJoiningMove
		), (
			String
tryToMatchColourFlippedPositionTag,
			TryToMatchMoves -> ShowS
forall a. Show a => a -> ShowS
shows TryToMatchMoves
tryToMatchColourFlippedPosition
		)
	 ]

instance Data.Default.Default StandardOpeningOptions where
	def :: StandardOpeningOptions
def = MkStandardOpeningOptions :: TryToMatchMoves
-> TryToMatchMoves -> TryToMatchMoves -> StandardOpeningOptions
MkStandardOpeningOptions {
		getTryToMatchMoves :: TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
True,
		getTryToMatchViaJoiningMove :: TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
True,
		getTryToMatchColourFlippedPosition :: TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
True
	}

instance HXT.XmlPickler StandardOpeningOptions where
	xpickle :: PU StandardOpeningOptions
xpickle	= StandardOpeningOptions
-> PU StandardOpeningOptions -> PU StandardOpeningOptions
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault StandardOpeningOptions
forall a. Default a => a
Data.Default.def (PU StandardOpeningOptions -> PU StandardOpeningOptions)
-> (PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
    -> PU StandardOpeningOptions)
-> PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
-> PU StandardOpeningOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU StandardOpeningOptions -> PU StandardOpeningOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU StandardOpeningOptions -> PU StandardOpeningOptions)
-> (PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
    -> PU StandardOpeningOptions)
-> PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
-> PU StandardOpeningOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
 -> StandardOpeningOptions,
 StandardOpeningOptions
 -> (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves))
-> PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
-> PU StandardOpeningOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(TryToMatchMoves
a, TryToMatchMoves
b, TryToMatchMoves
c) -> TryToMatchMoves
-> TryToMatchMoves -> TryToMatchMoves -> StandardOpeningOptions
mkStandardOpeningOptions TryToMatchMoves
a TryToMatchMoves
b TryToMatchMoves
c,	-- Construct.
		\MkStandardOpeningOptions {
			getTryToMatchMoves :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
			getTryToMatchViaJoiningMove :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
			getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition
		} -> (TryToMatchMoves
tryToMatchMoves, TryToMatchMoves
tryToMatchViaJoiningMove, TryToMatchMoves
tryToMatchColourFlippedPosition) -- Deconstruct.
	 ) (PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
 -> PU StandardOpeningOptions)
-> PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
-> PU StandardOpeningOptions
forall a b. (a -> b) -> a -> b
$ PU TryToMatchMoves
-> PU TryToMatchMoves
-> PU TryToMatchMoves
-> PU (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
HXT.xpTriple(
		StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves StandardOpeningOptions
def TryToMatchMoves -> PU TryToMatchMoves -> PU TryToMatchMoves
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU TryToMatchMoves -> PU TryToMatchMoves
forall a. String -> PU a -> PU a
HXT.xpAttr String
tryToMatchMovesTag PU TryToMatchMoves
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove StandardOpeningOptions
def TryToMatchMoves -> PU TryToMatchMoves -> PU TryToMatchMoves
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU TryToMatchMoves -> PU TryToMatchMoves
forall a. String -> PU a -> PU a
HXT.xpAttr String
tryToMatchViaJoiningMoveTag PU TryToMatchMoves
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition StandardOpeningOptions
def TryToMatchMoves -> PU TryToMatchMoves -> PU TryToMatchMoves
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU TryToMatchMoves -> PU TryToMatchMoves
forall a. String -> PU a -> PU a
HXT.xpAttr String
tryToMatchColourFlippedPositionTag PU TryToMatchMoves
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) where
		def :: StandardOpeningOptions
def	= StandardOpeningOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkStandardOpeningOptions
	:: TryToMatchMoves
	-> TryToMatchViaJoiningMove
	-> TryToMatchColourFlippedPosition
	-> StandardOpeningOptions
mkStandardOpeningOptions :: TryToMatchMoves
-> TryToMatchMoves -> TryToMatchMoves -> StandardOpeningOptions
mkStandardOpeningOptions TryToMatchMoves
tryToMatchMoves TryToMatchMoves
tryToMatchViaJoiningMove TryToMatchMoves
tryToMatchColourFlippedPosition	= MkStandardOpeningOptions :: TryToMatchMoves
-> TryToMatchMoves -> TryToMatchMoves -> StandardOpeningOptions
MkStandardOpeningOptions {
	getTryToMatchMoves :: TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
	getTryToMatchViaJoiningMove :: TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
	getTryToMatchColourFlippedPosition :: TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition
}

-- | Accessor.
getMatchSwitches :: StandardOpeningOptions -> MatchSwitches
getMatchSwitches :: StandardOpeningOptions
-> (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves)
getMatchSwitches MkStandardOpeningOptions {
	getTryToMatchMoves :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
	getTryToMatchViaJoiningMove :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
	getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition
} = (TryToMatchMoves
tryToMatchMoves, TryToMatchMoves
tryToMatchViaJoiningMove, TryToMatchMoves
tryToMatchColourFlippedPosition)