{-
	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,
		getMaybeMaximumPliesSinceMatch
	),
-- * Constants
	tag,
--	tryToMatchMovesTag,
--	tryToMatchViaJoiningMoveTag,
--	tryToMatchColourFlippedPositionTag,
--	preferVictoriesTag,
--	maximumPliesSinceMatchTag,
-- * Functions
-- ** Constructor
	mkStandardOpeningOptions,
-- ** Accessors
	getMatchSwitches
) where

import			BishBosh.Data.Bool()	-- For 'HXT.xpickle'.
import qualified	BishBosh.Text.ShowList						as Text.ShowList
import qualified	BishBosh.Type.Count						as Type.Count
import qualified	Control.DeepSeq
import qualified	Data.Default
import qualified	Data.Maybe
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"

-- | Used to qualify XML.
maximumPliesSinceMatchTag :: String
maximumPliesSinceMatchTag :: String
maximumPliesSinceMatchTag		= String
"maximumPliesSinceMatch"

-- | Defines options related to searching for a move.
data StandardOpeningOptions	= MkStandardOpeningOptions {
	StandardOpeningOptions -> Maybe NPlies
getMaybeMaximumPliesSinceMatch		:: Maybe Type.Count.NPlies,								-- ^ The optional maximum number of plies, after the last match with a prerecorded game, before abandoning further attempts. If unspecified then there's no limit.
	StandardOpeningOptions -> PreferVictories
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.
	StandardOpeningOptions -> PreferVictories
getTryToMatchMoves			:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves,			-- ^ Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched.
	StandardOpeningOptions -> PreferVictories
getTryToMatchViaJoiningMove		:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchViaJoiningMove,		-- ^ Whether to attempt to join the current position to a standard opening that's only one ply away.
	StandardOpeningOptions -> PreferVictories
getTryToMatchColourFlippedPosition	:: ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition	-- ^ Whether to attempt to match a colour-flipped version of the current position with a standard opening.
} deriving StandardOpeningOptions -> StandardOpeningOptions -> PreferVictories
(StandardOpeningOptions
 -> StandardOpeningOptions -> PreferVictories)
-> (StandardOpeningOptions
    -> StandardOpeningOptions -> PreferVictories)
-> Eq StandardOpeningOptions
forall a.
(a -> a -> PreferVictories) -> (a -> a -> PreferVictories) -> Eq a
/= :: StandardOpeningOptions -> StandardOpeningOptions -> PreferVictories
$c/= :: StandardOpeningOptions -> StandardOpeningOptions -> PreferVictories
== :: StandardOpeningOptions -> StandardOpeningOptions -> PreferVictories
$c== :: StandardOpeningOptions -> StandardOpeningOptions -> PreferVictories
Eq

instance Control.DeepSeq.NFData StandardOpeningOptions where
	rnf :: StandardOpeningOptions -> ()
rnf MkStandardOpeningOptions {
		getMaybeMaximumPliesSinceMatch :: StandardOpeningOptions -> Maybe NPlies
getMaybeMaximumPliesSinceMatch		= Maybe NPlies
maybeMaximumPliesSinceMatch,
		getPreferVictories :: StandardOpeningOptions -> PreferVictories
getPreferVictories			= PreferVictories
preferVictories,
		getTryToMatchMoves :: StandardOpeningOptions -> PreferVictories
getTryToMatchMoves			= PreferVictories
tryToMatchMoves,
		getTryToMatchViaJoiningMove :: StandardOpeningOptions -> PreferVictories
getTryToMatchViaJoiningMove		= PreferVictories
tryToMatchViaJoiningMove,
		getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> PreferVictories
getTryToMatchColourFlippedPosition	= PreferVictories
tryToMatchColourFlippedPosition
	} = (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
 PreferVictories)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Maybe NPlies
maybeMaximumPliesSinceMatch, PreferVictories
preferVictories, PreferVictories
tryToMatchMoves, PreferVictories
tryToMatchViaJoiningMove, PreferVictories
tryToMatchColourFlippedPosition)

instance Show StandardOpeningOptions where
	showsPrec :: NPlies -> StandardOpeningOptions -> ShowS
showsPrec NPlies
_ MkStandardOpeningOptions {
		getMaybeMaximumPliesSinceMatch :: StandardOpeningOptions -> Maybe NPlies
getMaybeMaximumPliesSinceMatch		= Maybe NPlies
maybeMaximumPliesSinceMatch,
		getPreferVictories :: StandardOpeningOptions -> PreferVictories
getPreferVictories			= PreferVictories
preferVictories,
		getTryToMatchMoves :: StandardOpeningOptions -> PreferVictories
getTryToMatchMoves			= PreferVictories
tryToMatchMoves,
		getTryToMatchViaJoiningMove :: StandardOpeningOptions -> PreferVictories
getTryToMatchViaJoiningMove		= PreferVictories
tryToMatchViaJoiningMove,
		getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> PreferVictories
getTryToMatchColourFlippedPosition	= PreferVictories
tryToMatchColourFlippedPosition
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(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
maximumPliesSinceMatchTag (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
maybeMaximumPliesSinceMatch [
		(
			String
preferVictoriesTag,
			PreferVictories -> ShowS
forall a. Show a => a -> ShowS
shows PreferVictories
preferVictories
		), (
			String
tryToMatchMovesTag,
			PreferVictories -> ShowS
forall a. Show a => a -> ShowS
shows PreferVictories
tryToMatchMoves
		), (
			String
tryToMatchViaJoiningMoveTag,
			PreferVictories -> ShowS
forall a. Show a => a -> ShowS
shows PreferVictories
tryToMatchViaJoiningMove
		), (
			String
tryToMatchColourFlippedPositionTag,
			PreferVictories -> ShowS
forall a. Show a => a -> ShowS
shows PreferVictories
tryToMatchColourFlippedPosition
		)
	 ]

instance Data.Default.Default StandardOpeningOptions where
	def :: StandardOpeningOptions
def = MkStandardOpeningOptions :: Maybe NPlies
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> StandardOpeningOptions
MkStandardOpeningOptions {
		getMaybeMaximumPliesSinceMatch :: Maybe NPlies
getMaybeMaximumPliesSinceMatch		= Maybe NPlies
forall a. Maybe a
Nothing,	-- Unlimited.
		getPreferVictories :: PreferVictories
getPreferVictories			= PreferVictories
True,
		getTryToMatchMoves :: PreferVictories
getTryToMatchMoves			= PreferVictories
True,
		getTryToMatchViaJoiningMove :: PreferVictories
getTryToMatchViaJoiningMove		= PreferVictories
True,
		getTryToMatchColourFlippedPosition :: PreferVictories
getTryToMatchColourFlippedPosition	= PreferVictories
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
      (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
       PreferVictories)
    -> PU StandardOpeningOptions)
-> PU
     (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
      PreferVictories)
-> 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
      (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
       PreferVictories)
    -> PU StandardOpeningOptions)
-> PU
     (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
      PreferVictories)
-> PU StandardOpeningOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
  PreferVictories)
 -> StandardOpeningOptions,
 StandardOpeningOptions
 -> (Maybe NPlies, PreferVictories, PreferVictories,
     PreferVictories, PreferVictories))
-> PU
     (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
      PreferVictories)
-> PU StandardOpeningOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(Maybe NPlies
a, PreferVictories
b, PreferVictories
c, PreferVictories
d, PreferVictories
e) -> Maybe NPlies
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> StandardOpeningOptions
mkStandardOpeningOptions Maybe NPlies
a PreferVictories
b PreferVictories
c PreferVictories
d PreferVictories
e,	-- Construct.
		\MkStandardOpeningOptions {
			getMaybeMaximumPliesSinceMatch :: StandardOpeningOptions -> Maybe NPlies
getMaybeMaximumPliesSinceMatch		= Maybe NPlies
maybeMaximumPliesSinceMatch,
			getPreferVictories :: StandardOpeningOptions -> PreferVictories
getPreferVictories			= PreferVictories
preferVictories,
			getTryToMatchMoves :: StandardOpeningOptions -> PreferVictories
getTryToMatchMoves			= PreferVictories
tryToMatchMoves,
			getTryToMatchViaJoiningMove :: StandardOpeningOptions -> PreferVictories
getTryToMatchViaJoiningMove		= PreferVictories
tryToMatchViaJoiningMove,
			getTryToMatchColourFlippedPosition :: StandardOpeningOptions -> PreferVictories
getTryToMatchColourFlippedPosition	= PreferVictories
tryToMatchColourFlippedPosition
		} -> (Maybe NPlies
maybeMaximumPliesSinceMatch, PreferVictories
preferVictories, PreferVictories
tryToMatchMoves, PreferVictories
tryToMatchViaJoiningMove, PreferVictories
tryToMatchColourFlippedPosition) -- Deconstruct.
	 ) (PU
   (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
    PreferVictories)
 -> PU StandardOpeningOptions)
-> PU
     (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
      PreferVictories)
-> PU StandardOpeningOptions
forall a b. (a -> b) -> a -> b
$ PU (Maybe NPlies)
-> PU PreferVictories
-> PU PreferVictories
-> PU PreferVictories
-> PU PreferVictories
-> PU
     (Maybe NPlies, PreferVictories, PreferVictories, PreferVictories,
      PreferVictories)
forall a b c d e.
PU a -> PU b -> PU c -> PU d -> PU e -> PU (a, b, c, d, e)
HXT.xp5Tuple (
		PU NPlies -> PU (Maybe NPlies)
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU NPlies -> PU (Maybe NPlies)) -> PU NPlies -> PU (Maybe NPlies)
forall a b. (a -> b) -> a -> b
$ String -> PU NPlies -> PU NPlies
forall a. String -> PU a -> PU a
HXT.xpAttr String
maximumPliesSinceMatchTag PU NPlies
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		StandardOpeningOptions -> PreferVictories
getPreferVictories StandardOpeningOptions
def PreferVictories -> PU PreferVictories -> PU PreferVictories
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU PreferVictories -> PU PreferVictories
forall a. String -> PU a -> PU a
HXT.xpAttr String
preferVictoriesTag PU PreferVictories
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		StandardOpeningOptions -> PreferVictories
getTryToMatchMoves StandardOpeningOptions
def PreferVictories -> PU PreferVictories -> PU PreferVictories
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU PreferVictories -> PU PreferVictories
forall a. String -> PU a -> PU a
HXT.xpAttr String
tryToMatchMovesTag PU PreferVictories
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		StandardOpeningOptions -> PreferVictories
getTryToMatchViaJoiningMove StandardOpeningOptions
def PreferVictories -> PU PreferVictories -> PU PreferVictories
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU PreferVictories -> PU PreferVictories
forall a. String -> PU a -> PU a
HXT.xpAttr String
tryToMatchViaJoiningMoveTag PU PreferVictories
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		StandardOpeningOptions -> PreferVictories
getTryToMatchColourFlippedPosition StandardOpeningOptions
def PreferVictories -> PU PreferVictories -> PU PreferVictories
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU PreferVictories -> PU PreferVictories
forall a. String -> PU a -> PU a
HXT.xpAttr String
tryToMatchColourFlippedPositionTag PU PreferVictories
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) where
		def :: StandardOpeningOptions
def	= StandardOpeningOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkStandardOpeningOptions
	:: Maybe Type.Count.NPlies	-- ^ The optional maximum number of plies, after the last position matched against a standard opening, to abandon further match-attempts.
	-> ContextualNotation.PositionHashQualifiedMoveTree.PreferVictories
	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchMoves
	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchViaJoiningMove
	-> ContextualNotation.PositionHashQualifiedMoveTree.TryToMatchColourFlippedPosition
	-> StandardOpeningOptions
mkStandardOpeningOptions :: Maybe NPlies
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> StandardOpeningOptions
mkStandardOpeningOptions Maybe NPlies
maybeNPlies PreferVictories
preferVictories PreferVictories
tryToMatchMoves PreferVictories
tryToMatchViaJoiningMove PreferVictories
tryToMatchColourFlippedPosition	= MkStandardOpeningOptions :: Maybe NPlies
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> PreferVictories
-> StandardOpeningOptions
MkStandardOpeningOptions {
	getMaybeMaximumPliesSinceMatch :: Maybe NPlies
getMaybeMaximumPliesSinceMatch		= Maybe NPlies
maybeNPlies,
	getPreferVictories :: PreferVictories
getPreferVictories			= PreferVictories
preferVictories,
	getTryToMatchMoves :: PreferVictories
getTryToMatchMoves			= PreferVictories
tryToMatchMoves,
	getTryToMatchViaJoiningMove :: PreferVictories
getTryToMatchViaJoiningMove		= PreferVictories
tryToMatchViaJoiningMove,
	getTryToMatchColourFlippedPosition :: PreferVictories
getTryToMatchColourFlippedPosition	= PreferVictories
tryToMatchColourFlippedPosition
}

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