{-
	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
-- ** Data-types
	StandardOpeningOptions(
--		MkStandardOpeningOptions,
--		getTryToMatchMoves,
--		getTryToMatchViaJoiningMove,
--		getTryToMatchColourFlippedPosition,
		getPreferVictories
	),
-- * Constants
	tag,
--	tryToMatchMovesTag,
--	tryToMatchViaJoiningMoveTag,
--	tryToMatchColourFlippedPositionTag,
--	preferVictoriesTag,
-- * 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	BishBosh.ContextualNotation.PositionHashQualifiedMoveTree	as ContextualNotation.PositionHashQualifiedMoveTree
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"

-- | Used to qualify XML.
preferVictoriesTag :: String
preferVictoriesTag :: String
preferVictoriesTag			= String
"preferVictories"

-- | Defines options related to searching for a move.
data StandardOpeningOptions	= MkStandardOpeningOptions {
	StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves,			-- ^ Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched.
	StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchViaJoiningMove,		-- ^ Whether to attempt to join the current position to a standard opening that's only one ply away.
	StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition,	-- ^ Whether to attempt to match a colour-flipped version of the current position with a standard opening.
	StandardOpeningOptions -> TryToMatchMoves
getPreferVictories			:: ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories			-- ^ Whether from all matching positions extracted from PGN-Databases, to prefer moves which result in a greater probability of victory, for the player who has the next move.
} 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,
		getPreferVictories :: StandardOpeningOptions -> TryToMatchMoves
getPreferVictories			= TryToMatchMoves
preferVictories
	} = (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
 TryToMatchMoves)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (TryToMatchMoves
tryToMatchMoves, TryToMatchMoves
tryToMatchViaJoiningMove, TryToMatchMoves
tryToMatchColourFlippedPosition, TryToMatchMoves
preferVictories)

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,
		getPreferVictories :: StandardOpeningOptions -> TryToMatchMoves
getPreferVictories			= TryToMatchMoves
preferVictories
	} = [(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
		), (
			String
preferVictoriesTag,
			TryToMatchMoves -> ShowS
forall a. Show a => a -> ShowS
shows TryToMatchMoves
preferVictories
		)
	 ]

instance Data.Default.Default StandardOpeningOptions where
	def :: StandardOpeningOptions
def = MkStandardOpeningOptions :: TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> StandardOpeningOptions
MkStandardOpeningOptions {
		getTryToMatchMoves :: TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
True,
		getTryToMatchViaJoiningMove :: TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
True,
		getTryToMatchColourFlippedPosition :: TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
True,
		getPreferVictories :: TryToMatchMoves
getPreferVictories			= 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,
       TryToMatchMoves)
    -> PU StandardOpeningOptions)
-> PU
     (TryToMatchMoves, 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,
       TryToMatchMoves)
    -> PU StandardOpeningOptions)
-> PU
     (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
      TryToMatchMoves)
-> PU StandardOpeningOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
  TryToMatchMoves)
 -> StandardOpeningOptions,
 StandardOpeningOptions
 -> (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
     TryToMatchMoves))
-> PU
     (TryToMatchMoves, 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
d) -> TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> StandardOpeningOptions
mkStandardOpeningOptions TryToMatchMoves
a TryToMatchMoves
b TryToMatchMoves
c TryToMatchMoves
d,	-- Construct.
		\MkStandardOpeningOptions {
			getTryToMatchMoves :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
			getTryToMatchViaJoiningMove :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
			getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition,
			getPreferVictories :: StandardOpeningOptions -> TryToMatchMoves
getPreferVictories			= TryToMatchMoves
preferVictories
		} -> (TryToMatchMoves
tryToMatchMoves, TryToMatchMoves
tryToMatchViaJoiningMove, TryToMatchMoves
tryToMatchColourFlippedPosition, TryToMatchMoves
preferVictories) -- Deconstruct.
	 ) (PU
   (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
    TryToMatchMoves)
 -> PU StandardOpeningOptions)
-> PU
     (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
      TryToMatchMoves)
-> PU StandardOpeningOptions
forall a b. (a -> b) -> a -> b
$ PU TryToMatchMoves
-> PU TryToMatchMoves
-> PU TryToMatchMoves
-> PU TryToMatchMoves
-> PU
     (TryToMatchMoves, TryToMatchMoves, TryToMatchMoves,
      TryToMatchMoves)
forall a b c d. PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
HXT.xp4Tuple (
		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
	 ) (
		StandardOpeningOptions -> TryToMatchMoves
getPreferVictories 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
preferVictoriesTag 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
	:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves
	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchViaJoiningMove
	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition
	-> ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories
	-> StandardOpeningOptions
mkStandardOpeningOptions :: TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> StandardOpeningOptions
mkStandardOpeningOptions TryToMatchMoves
tryToMatchMoves TryToMatchMoves
tryToMatchViaJoiningMove TryToMatchMoves
tryToMatchColourFlippedPosition TryToMatchMoves
preferVictories	= MkStandardOpeningOptions :: TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> TryToMatchMoves
-> StandardOpeningOptions
MkStandardOpeningOptions {
	getTryToMatchMoves :: TryToMatchMoves
getTryToMatchMoves			= TryToMatchMoves
tryToMatchMoves,
	getTryToMatchViaJoiningMove :: TryToMatchMoves
getTryToMatchViaJoiningMove		= TryToMatchMoves
tryToMatchViaJoiningMove,
	getTryToMatchColourFlippedPosition :: TryToMatchMoves
getTryToMatchColourFlippedPosition	= TryToMatchMoves
tryToMatchColourFlippedPosition,
	getPreferVictories :: TryToMatchMoves
getPreferVictories			= TryToMatchMoves
preferVictories
}

-- | Accessor.
getMatchSwitches :: StandardOpeningOptions -> ContextualNotation.PositionHashQualifiedMoveTree.MatchSwitches
getMatchSwitches :: StandardOpeningOptions -> MatchSwitches
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)