{-
	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 for the optimal move.
-}

module BishBosh.Input.SearchOptions(
-- * Types
-- ** Type-synonyms
	SearchDepth,
	PreferMovesTowardsCentre,
	SortOnStandardOpeningMoveFrequency,
	HammingDistance,
--	Transformation,
--	RecordKillerMoves,
	MaybeRetireAfterNMoves,
	TrapRepeatedPositions,
--	UsePondering,
	MaybeUseTranspositions,
--	StandardOpeningOptions,
--	SearchDepthByLogicalColour,
	Reader,
-- ** Data-types
	SearchOptions(
--		MkSearchOptions,
		getPreferMovesTowardsCentre,
		getSortOnStandardOpeningMoveFrequency,
		getMaybeCaptureMoveSortAlgorithm,
		getMaybeMinimumHammingDistance,
		getMaybeRetireKillerMovesAfter,
		getTrapRepeatedPositions,
		getUsePondering,
		getMaybeUseTranspositions,
		getStandardOpeningOptions,
		getSearchDepthByLogicalColour
	),
-- * Constants
	tag,
--	preferMovesTowardsCentreTag
--	sortOnStandardOpeningMoveFrequencyTag
--	minimumHammingDistanceTag,
--	retireKillerMovesAfterTag,
--	trapRepeatedPositionsTag,
--	usePonderingTag,
--	retireTranspositionsAfterTag,
--	minimumTranspositionSearchDepthTag,
--	standardOpeningOptionsTag,
	searchDepthTag,
--	searchDepthByLogicalColourTag
	minimumSearchDepth,
	defaultSearchDepth,
-- * Functions
-- ** Constructor
	mkSearchOptions,
-- ** Accessors
	getSearchDepth,
	maybeRetireTranspositionsAfter,
	maybeMinimumTranspositionSearchDepth,
-- ** Mutators
	setSearchDepth,
	swapSearchDepth,
-- ** Predicates
	recordKillerMoves
) where

import			BishBosh.Data.Bool()		-- For 'HXT.xpickle'.
import			BishBosh.Data.Integral()	-- For 'HXT.XmlPickler NMoves'.
import			Control.Arrow((***))
import qualified	BishBosh.Attribute.CaptureMoveSortAlgorithm	as Attribute.CaptureMoveSortAlgorithm
import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour
import qualified	BishBosh.Component.Move				as Component.Move
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Input.StandardOpeningOptions		as Input.StandardOpeningOptions
import qualified	BishBosh.Property.Opposable			as Property.Opposable
import qualified	BishBosh.Text.ShowList				as Text.ShowList
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Control.Monad.Reader
import qualified	Data.Default
import qualified	Data.Foldable
import qualified	Data.Map
import qualified	Data.Maybe
import qualified	Text.XML.HXT.Arrow.Pickle			as HXT

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

-- | Used to qualify XML.
preferMovesTowardsCentreTag :: String
preferMovesTowardsCentreTag :: String
preferMovesTowardsCentreTag		= String
"preferMovesTowardsCentre"

-- | Used to qualify XML.
sortOnStandardOpeningMoveFrequencyTag :: String
sortOnStandardOpeningMoveFrequencyTag :: String
sortOnStandardOpeningMoveFrequencyTag	= String
"sortOnStandardOpeningMoveFrequency"

-- | Used to qualify XML.
minimumHammingDistanceTag :: String
minimumHammingDistanceTag :: String
minimumHammingDistanceTag		= String
"minimumHammingDistance"

-- | Used to qualify XML.
retireKillerMovesAfterTag :: String
retireKillerMovesAfterTag :: String
retireKillerMovesAfterTag		= String
"retireKillerMovesAfter"

-- | Used to qualify XML.
trapRepeatedPositionsTag :: String
trapRepeatedPositionsTag :: String
trapRepeatedPositionsTag		= String
"trapRepeatedPositions"

-- | Used to qualify XML.
usePonderingTag :: String
usePonderingTag :: String
usePonderingTag				= String
"usePondering"

-- | Used to qualify XML.
retireTranspositionsAfterTag :: String
retireTranspositionsAfterTag :: String
retireTranspositionsAfterTag		= String
"retireTranspositionsAfter"

-- | Used to qualify XML.
minimumTranspositionSearchDepthTag :: String
minimumTranspositionSearchDepthTag :: String
minimumTranspositionSearchDepthTag	= String
"minimumTranspositionSearchDepth"

-- | Used to qualify XML.
searchDepthTag :: String
searchDepthTag :: String
searchDepthTag				= String
"searchDepth"

-- | Used to qualify XML.
searchDepthByLogicalColourTag :: String
searchDepthByLogicalColourTag :: String
searchDepthByLogicalColourTag		= String -> ShowS
showString String
searchDepthTag String
"ByLogicalColour"

-- | The number of plies to search for the optimal move.
type SearchDepth	= Component.Move.NMoves

-- | The minimum permissible search-depth.
minimumSearchDepth :: SearchDepth
minimumSearchDepth :: SearchDepth
minimumSearchDepth	= SearchDepth
1

{- |
	* The default search-depth.

	* CAVEAT: this is rather arbitrary.
-}
defaultSearchDepth :: SearchDepth
defaultSearchDepth :: SearchDepth
defaultSearchDepth	= SearchDepth
4

-- | Whether to prefer moves which progress towards the centre of the board.
type PreferMovesTowardsCentre		= Bool

-- | Sort moves on the decreasing frequency of occurrence in standard openings.
type SortOnStandardOpeningMoveFrequency	= Bool

-- | The optional minimum Hamming-distance between the random numbers from which Zobrist-hashes are composed.
type HammingDistance			= Int

-- | The number of full moves (one for each player) after which to retire killer moves.
type MaybeRetireAfterNMoves		= Maybe Component.Move.NMoves

-- | Whether to short-circuit the fitness-evaluation of /position/s which have been visited before in the current /game/.
type TrapRepeatedPositions		= Bool

-- | Whether to ponder about one's next move while the opponent is thinking.
type UsePondering			= Bool

-- | The number of full moves (one for each player) after which to retire transpositions & the search-depth beneath which they aren't recorded at all.
type MaybeUseTranspositions		= Maybe (Component.Move.NMoves, SearchDepth)

-- | The depth to search for each /logical colour/.
type SearchDepthByLogicalColour		= Data.Map.Map Attribute.LogicalColour.LogicalColour SearchDepth

-- | Defines options related to searching for a move.
data SearchOptions	= MkSearchOptions {
	SearchOptions -> PreferMovesTowardsCentre
getPreferMovesTowardsCentre		:: PreferMovesTowardsCentre,
	SearchOptions -> PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency	:: SortOnStandardOpeningMoveFrequency,
	SearchOptions -> Maybe CaptureMoveSortAlgorithm
getMaybeCaptureMoveSortAlgorithm	:: Maybe Attribute.CaptureMoveSortAlgorithm.CaptureMoveSortAlgorithm,
	SearchOptions -> Maybe SearchDepth
getMaybeMinimumHammingDistance		:: Maybe HammingDistance,
	SearchOptions -> Maybe SearchDepth
getMaybeRetireKillerMovesAfter		:: MaybeRetireAfterNMoves,
	SearchOptions -> PreferMovesTowardsCentre
getTrapRepeatedPositions		:: TrapRepeatedPositions,
	SearchOptions -> PreferMovesTowardsCentre
getUsePondering				:: UsePondering,
	SearchOptions -> MaybeUseTranspositions
getMaybeUseTranspositions		:: MaybeUseTranspositions,
	SearchOptions -> StandardOpeningOptions
getStandardOpeningOptions		:: Input.StandardOpeningOptions.StandardOpeningOptions,
	SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour		:: SearchDepthByLogicalColour
} deriving SearchOptions -> SearchOptions -> PreferMovesTowardsCentre
(SearchOptions -> SearchOptions -> PreferMovesTowardsCentre)
-> (SearchOptions -> SearchOptions -> PreferMovesTowardsCentre)
-> Eq SearchOptions
forall a.
(a -> a -> PreferMovesTowardsCentre)
-> (a -> a -> PreferMovesTowardsCentre) -> Eq a
/= :: SearchOptions -> SearchOptions -> PreferMovesTowardsCentre
$c/= :: SearchOptions -> SearchOptions -> PreferMovesTowardsCentre
== :: SearchOptions -> SearchOptions -> PreferMovesTowardsCentre
$c== :: SearchOptions -> SearchOptions -> PreferMovesTowardsCentre
Eq

instance Control.DeepSeq.NFData SearchOptions where
	rnf :: SearchOptions -> ()
rnf MkSearchOptions {
		getPreferMovesTowardsCentre :: SearchOptions -> PreferMovesTowardsCentre
getPreferMovesTowardsCentre		= PreferMovesTowardsCentre
preferMovesTowardsCentre,
		getSortOnStandardOpeningMoveFrequency :: SearchOptions -> PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency	= PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency,
		getMaybeCaptureMoveSortAlgorithm :: SearchOptions -> Maybe CaptureMoveSortAlgorithm
getMaybeCaptureMoveSortAlgorithm	= Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm,
		getMaybeMinimumHammingDistance :: SearchOptions -> Maybe SearchDepth
getMaybeMinimumHammingDistance		= Maybe SearchDepth
maybeMinimumHammingDistance,
		getMaybeRetireKillerMovesAfter :: SearchOptions -> Maybe SearchDepth
getMaybeRetireKillerMovesAfter		= Maybe SearchDepth
maybeRetireKillerMovesAfter,
		getTrapRepeatedPositions :: SearchOptions -> PreferMovesTowardsCentre
getTrapRepeatedPositions		= PreferMovesTowardsCentre
trapRepeatedPositions,
		getUsePondering :: SearchOptions -> PreferMovesTowardsCentre
getUsePondering				= PreferMovesTowardsCentre
usePondering,
		getMaybeUseTranspositions :: SearchOptions -> MaybeUseTranspositions
getMaybeUseTranspositions		= MaybeUseTranspositions
maybeUseTranspositions,
		getStandardOpeningOptions :: SearchOptions -> StandardOpeningOptions
getStandardOpeningOptions		= StandardOpeningOptions
standardOpeningOptions,
		getSearchDepthByLogicalColour :: SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour		= SearchDepthByLogicalColour
searchDepthByLogicalColour
	} = ((PreferMovesTowardsCentre, PreferMovesTowardsCentre,
  Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
  Maybe SearchDepth),
 (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
  MaybeUseTranspositions, StandardOpeningOptions,
  SearchDepthByLogicalColour))
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
		(
			PreferMovesTowardsCentre
preferMovesTowardsCentre, PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency, Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm, Maybe SearchDepth
maybeMinimumHammingDistance, Maybe SearchDepth
maybeRetireKillerMovesAfter
		), (
			PreferMovesTowardsCentre
trapRepeatedPositions, PreferMovesTowardsCentre
usePondering, MaybeUseTranspositions
maybeUseTranspositions, StandardOpeningOptions
standardOpeningOptions, SearchDepthByLogicalColour
searchDepthByLogicalColour
		)
	 )

instance Show SearchOptions where
	showsPrec :: SearchDepth -> SearchOptions -> ShowS
showsPrec SearchDepth
_ MkSearchOptions {
		getPreferMovesTowardsCentre :: SearchOptions -> PreferMovesTowardsCentre
getPreferMovesTowardsCentre		= PreferMovesTowardsCentre
preferMovesTowardsCentre,
		getSortOnStandardOpeningMoveFrequency :: SearchOptions -> PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency	= PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency,
		getMaybeCaptureMoveSortAlgorithm :: SearchOptions -> Maybe CaptureMoveSortAlgorithm
getMaybeCaptureMoveSortAlgorithm	= Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm,
		getMaybeMinimumHammingDistance :: SearchOptions -> Maybe SearchDepth
getMaybeMinimumHammingDistance		= Maybe SearchDepth
maybeMinimumHammingDistance,
		getMaybeRetireKillerMovesAfter :: SearchOptions -> Maybe SearchDepth
getMaybeRetireKillerMovesAfter		= Maybe SearchDepth
maybeRetireKillerMovesAfter,
		getTrapRepeatedPositions :: SearchOptions -> PreferMovesTowardsCentre
getTrapRepeatedPositions		= PreferMovesTowardsCentre
trapRepeatedPositions,
		getUsePondering :: SearchOptions -> PreferMovesTowardsCentre
getUsePondering				= PreferMovesTowardsCentre
usePondering,
		getMaybeUseTranspositions :: SearchOptions -> MaybeUseTranspositions
getMaybeUseTranspositions		= MaybeUseTranspositions
maybeUseTranspositions,
		getStandardOpeningOptions :: SearchOptions -> StandardOpeningOptions
getStandardOpeningOptions		= StandardOpeningOptions
standardOpeningOptions,
		getSearchDepthByLogicalColour :: SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour		= SearchDepthByLogicalColour
searchDepthByLogicalColour
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> ([(String, ShowS)] -> [(String, ShowS)])
-> [(String, ShowS)]
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, ShowS)] -> [(String, ShowS)])
-> (CaptureMoveSortAlgorithm
    -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe CaptureMoveSortAlgorithm
-> [(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)])
-> (CaptureMoveSortAlgorithm -> (String, ShowS))
-> CaptureMoveSortAlgorithm
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
Attribute.CaptureMoveSortAlgorithm.tag (ShowS -> (String, ShowS))
-> (CaptureMoveSortAlgorithm -> ShowS)
-> CaptureMoveSortAlgorithm
-> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaptureMoveSortAlgorithm -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm ([(String, ShowS)] -> [(String, ShowS)])
-> ([(String, ShowS)] -> [(String, ShowS)])
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, ShowS)] -> [(String, ShowS)])
-> (SearchDepth -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe SearchDepth
-> [(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)])
-> (SearchDepth -> (String, ShowS))
-> SearchDepth
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
minimumHammingDistanceTag (ShowS -> (String, ShowS))
-> (SearchDepth -> ShowS) -> SearchDepth -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe SearchDepth
maybeMinimumHammingDistance ([(String, ShowS)] -> [(String, ShowS)])
-> ([(String, ShowS)] -> [(String, ShowS)])
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, ShowS)] -> [(String, ShowS)])
-> (SearchDepth -> [(String, ShowS)] -> [(String, ShowS)])
-> Maybe SearchDepth
-> [(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)])
-> (SearchDepth -> (String, ShowS))
-> SearchDepth
-> [(String, ShowS)]
-> [(String, ShowS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
retireKillerMovesAfterTag (ShowS -> (String, ShowS))
-> (SearchDepth -> ShowS) -> SearchDepth -> (String, ShowS)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows
	 ) Maybe SearchDepth
maybeRetireKillerMovesAfter ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([(String, ShowS)] -> [(String, ShowS)])
-> ((SearchDepth, SearchDepth)
    -> [(String, ShowS)] -> [(String, ShowS)])
-> MaybeUseTranspositions
-> [(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 (
		\(SearchDepth
retireTranspositionsAfter, SearchDepth
minimumTranspositionSearchDepth)	-> [(String, ShowS)] -> [(String, ShowS)] -> [(String, ShowS)]
forall a. [a] -> [a] -> [a]
(++) [
			(
				String
preferMovesTowardsCentreTag,
				PreferMovesTowardsCentre -> ShowS
forall a. Show a => a -> ShowS
shows PreferMovesTowardsCentre
preferMovesTowardsCentre
			), (
				String
sortOnStandardOpeningMoveFrequencyTag,
				PreferMovesTowardsCentre -> ShowS
forall a. Show a => a -> ShowS
shows PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency
			), (
				String
retireTranspositionsAfterTag,
				SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
retireTranspositionsAfter
			), (
				String
minimumTranspositionSearchDepthTag,
				SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
minimumTranspositionSearchDepth
			)
		]
	 ) MaybeUseTranspositions
maybeUseTranspositions [
		(
			String
trapRepeatedPositionsTag,
			PreferMovesTowardsCentre -> ShowS
forall a. Show a => a -> ShowS
shows PreferMovesTowardsCentre
trapRepeatedPositions
		), (
			String
usePonderingTag,
			PreferMovesTowardsCentre -> ShowS
forall a. Show a => a -> ShowS
shows PreferMovesTowardsCentre
usePondering
		), (
			String
Input.StandardOpeningOptions.tag,
			StandardOpeningOptions -> ShowS
forall a. Show a => a -> ShowS
shows StandardOpeningOptions
standardOpeningOptions
		), (
			String
searchDepthByLogicalColourTag,
			[(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' ([(String, ShowS)] -> ShowS)
-> ([(LogicalColour, SearchDepth)] -> [(String, ShowS)])
-> [(LogicalColour, SearchDepth)]
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, SearchDepth) -> (String, ShowS))
-> [(LogicalColour, SearchDepth)] -> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour -> String
forall a. Show a => a -> String
show (LogicalColour -> String)
-> (SearchDepth -> ShowS)
-> (LogicalColour, SearchDepth)
-> (String, ShowS)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows) ([(LogicalColour, SearchDepth)] -> ShowS)
-> [(LogicalColour, SearchDepth)] -> ShowS
forall a b. (a -> b) -> a -> b
$ SearchDepthByLogicalColour -> [(LogicalColour, SearchDepth)]
forall k a. Map k a -> [(k, a)]
Data.Map.assocs SearchDepthByLogicalColour
searchDepthByLogicalColour
		)
	 ]

instance Data.Default.Default SearchOptions where
	def :: SearchOptions
def = MkSearchOptions :: PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> Maybe CaptureMoveSortAlgorithm
-> Maybe SearchDepth
-> Maybe SearchDepth
-> PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> MaybeUseTranspositions
-> StandardOpeningOptions
-> SearchDepthByLogicalColour
-> SearchOptions
MkSearchOptions {
		getPreferMovesTowardsCentre :: PreferMovesTowardsCentre
getPreferMovesTowardsCentre		= PreferMovesTowardsCentre
True,
		getSortOnStandardOpeningMoveFrequency :: PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency	= PreferMovesTowardsCentre
False,
		getMaybeCaptureMoveSortAlgorithm :: Maybe CaptureMoveSortAlgorithm
getMaybeCaptureMoveSortAlgorithm	= Maybe CaptureMoveSortAlgorithm
forall a. Maybe a
Nothing,
		getMaybeMinimumHammingDistance :: Maybe SearchDepth
getMaybeMinimumHammingDistance		= Maybe SearchDepth
forall a. Maybe a
Nothing,
		getMaybeRetireKillerMovesAfter :: Maybe SearchDepth
getMaybeRetireKillerMovesAfter		= Maybe SearchDepth
forall a. Maybe a
Nothing,
		getTrapRepeatedPositions :: PreferMovesTowardsCentre
getTrapRepeatedPositions		= PreferMovesTowardsCentre
True,
		getUsePondering :: PreferMovesTowardsCentre
getUsePondering				= PreferMovesTowardsCentre
False,
		getMaybeUseTranspositions :: MaybeUseTranspositions
getMaybeUseTranspositions		= MaybeUseTranspositions
forall a. Maybe a
Nothing,
		getStandardOpeningOptions :: StandardOpeningOptions
getStandardOpeningOptions		= StandardOpeningOptions
forall a. Default a => a
Data.Default.def,
		getSearchDepthByLogicalColour :: SearchDepthByLogicalColour
getSearchDepthByLogicalColour		= SearchDepthByLogicalColour
forall k a. Map k a
Data.Map.empty	-- Manual.
	}

instance HXT.XmlPickler SearchOptions where
	xpickle :: PU SearchOptions
xpickle	= SearchOptions -> PU SearchOptions -> PU SearchOptions
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault SearchOptions
forall a. Default a => a
Data.Default.def (PU SearchOptions -> PU SearchOptions)
-> (PU
      (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
       Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
       Maybe SearchDepth, PreferMovesTowardsCentre,
       PreferMovesTowardsCentre, MaybeUseTranspositions,
       StandardOpeningOptions, SearchDepthByLogicalColour)
    -> PU SearchOptions)
-> PU
     (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
      Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
      Maybe SearchDepth, PreferMovesTowardsCentre,
      PreferMovesTowardsCentre, MaybeUseTranspositions,
      StandardOpeningOptions, SearchDepthByLogicalColour)
-> PU SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU SearchOptions -> PU SearchOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU SearchOptions -> PU SearchOptions)
-> (PU
      (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
       Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
       Maybe SearchDepth, PreferMovesTowardsCentre,
       PreferMovesTowardsCentre, MaybeUseTranspositions,
       StandardOpeningOptions, SearchDepthByLogicalColour)
    -> PU SearchOptions)
-> PU
     (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
      Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
      Maybe SearchDepth, PreferMovesTowardsCentre,
      PreferMovesTowardsCentre, MaybeUseTranspositions,
      StandardOpeningOptions, SearchDepthByLogicalColour)
-> PU SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PreferMovesTowardsCentre, PreferMovesTowardsCentre,
  Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
  Maybe SearchDepth, PreferMovesTowardsCentre,
  PreferMovesTowardsCentre, MaybeUseTranspositions,
  StandardOpeningOptions, SearchDepthByLogicalColour)
 -> SearchOptions,
 SearchOptions
 -> (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
     Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
     Maybe SearchDepth, PreferMovesTowardsCentre,
     PreferMovesTowardsCentre, MaybeUseTranspositions,
     StandardOpeningOptions, SearchDepthByLogicalColour))
-> PU
     (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
      Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
      Maybe SearchDepth, PreferMovesTowardsCentre,
      PreferMovesTowardsCentre, MaybeUseTranspositions,
      StandardOpeningOptions, SearchDepthByLogicalColour)
-> PU SearchOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(PreferMovesTowardsCentre
a, PreferMovesTowardsCentre
b, Maybe CaptureMoveSortAlgorithm
c, Maybe SearchDepth
d, Maybe SearchDepth
e, PreferMovesTowardsCentre
f, PreferMovesTowardsCentre
g, MaybeUseTranspositions
h, StandardOpeningOptions
i, SearchDepthByLogicalColour
j) -> PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> Maybe CaptureMoveSortAlgorithm
-> Maybe SearchDepth
-> Maybe SearchDepth
-> PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> MaybeUseTranspositions
-> StandardOpeningOptions
-> SearchDepthByLogicalColour
-> SearchOptions
mkSearchOptions PreferMovesTowardsCentre
a PreferMovesTowardsCentre
b Maybe CaptureMoveSortAlgorithm
c Maybe SearchDepth
d Maybe SearchDepth
e PreferMovesTowardsCentre
f PreferMovesTowardsCentre
g MaybeUseTranspositions
h StandardOpeningOptions
i SearchDepthByLogicalColour
j,	-- Construct.
		\MkSearchOptions {
			getPreferMovesTowardsCentre :: SearchOptions -> PreferMovesTowardsCentre
getPreferMovesTowardsCentre		= PreferMovesTowardsCentre
preferMovesTowardsCentre,
			getSortOnStandardOpeningMoveFrequency :: SearchOptions -> PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency	= PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency,
			getMaybeCaptureMoveSortAlgorithm :: SearchOptions -> Maybe CaptureMoveSortAlgorithm
getMaybeCaptureMoveSortAlgorithm	= Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm,
			getMaybeMinimumHammingDistance :: SearchOptions -> Maybe SearchDepth
getMaybeMinimumHammingDistance		= Maybe SearchDepth
maybeMinimumHammingDistance,
			getMaybeRetireKillerMovesAfter :: SearchOptions -> Maybe SearchDepth
getMaybeRetireKillerMovesAfter		= Maybe SearchDepth
maybeRetireKillerMovesAfter,
			getTrapRepeatedPositions :: SearchOptions -> PreferMovesTowardsCentre
getTrapRepeatedPositions		= PreferMovesTowardsCentre
trapRepeatedPositions,
			getUsePondering :: SearchOptions -> PreferMovesTowardsCentre
getUsePondering				= PreferMovesTowardsCentre
usePondering,
			getMaybeUseTranspositions :: SearchOptions -> MaybeUseTranspositions
getMaybeUseTranspositions		= MaybeUseTranspositions
maybeUseTranspositions,
			getStandardOpeningOptions :: SearchOptions -> StandardOpeningOptions
getStandardOpeningOptions		= StandardOpeningOptions
standardOpeningOptions,
			getSearchDepthByLogicalColour :: SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour		= SearchDepthByLogicalColour
searchDepthByLogicalColour
		} -> (
			PreferMovesTowardsCentre
preferMovesTowardsCentre,
			PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency,
			Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm,
			Maybe SearchDepth
maybeMinimumHammingDistance,
			Maybe SearchDepth
maybeRetireKillerMovesAfter,
			PreferMovesTowardsCentre
trapRepeatedPositions,
			PreferMovesTowardsCentre
usePondering,
			MaybeUseTranspositions
maybeUseTranspositions,
			StandardOpeningOptions
standardOpeningOptions,
			SearchDepthByLogicalColour
searchDepthByLogicalColour
		) -- Deconstruct.
	 ) (PU
   (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
    Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
    Maybe SearchDepth, PreferMovesTowardsCentre,
    PreferMovesTowardsCentre, MaybeUseTranspositions,
    StandardOpeningOptions, SearchDepthByLogicalColour)
 -> PU SearchOptions)
-> PU
     (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
      Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
      Maybe SearchDepth, PreferMovesTowardsCentre,
      PreferMovesTowardsCentre, MaybeUseTranspositions,
      StandardOpeningOptions, SearchDepthByLogicalColour)
-> PU SearchOptions
forall a b. (a -> b) -> a -> b
$ PU PreferMovesTowardsCentre
-> PU PreferMovesTowardsCentre
-> PU (Maybe CaptureMoveSortAlgorithm)
-> PU (Maybe SearchDepth)
-> PU (Maybe SearchDepth)
-> PU PreferMovesTowardsCentre
-> PU PreferMovesTowardsCentre
-> PU MaybeUseTranspositions
-> PU StandardOpeningOptions
-> PU SearchDepthByLogicalColour
-> PU
     (PreferMovesTowardsCentre, PreferMovesTowardsCentre,
      Maybe CaptureMoveSortAlgorithm, Maybe SearchDepth,
      Maybe SearchDepth, PreferMovesTowardsCentre,
      PreferMovesTowardsCentre, MaybeUseTranspositions,
      StandardOpeningOptions, SearchDepthByLogicalColour)
forall a b c d e f g h i j.
PU a
-> PU b
-> PU c
-> PU d
-> PU e
-> PU f
-> PU g
-> PU h
-> PU i
-> PU j
-> PU (a, b, c, d, e, f, g, h, i, j)
HXT.xp10Tuple (
		SearchOptions -> PreferMovesTowardsCentre
getPreferMovesTowardsCentre SearchOptions
def PreferMovesTowardsCentre
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. String -> PU a -> PU a
HXT.xpAttr String
preferMovesTowardsCentreTag PU PreferMovesTowardsCentre
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (
		SearchOptions -> PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency SearchOptions
def PreferMovesTowardsCentre
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. String -> PU a -> PU a
HXT.xpAttr String
sortOnStandardOpeningMoveFrequencyTag PU PreferMovesTowardsCentre
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		PU CaptureMoveSortAlgorithm -> PU (Maybe CaptureMoveSortAlgorithm)
forall a. PU a -> PU (Maybe a)
HXT.xpOption PU CaptureMoveSortAlgorithm
forall a. XmlPickler a => PU a
HXT.xpickle {-CaptureMoveSortAlgorithm-}
	 ) (
		String -> PU SearchDepth -> PU (Maybe SearchDepth)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
minimumHammingDistanceTag PU SearchDepth
HXT.xpInt
	 ) (
		String -> PU SearchDepth -> PU (Maybe SearchDepth)
forall a. String -> PU a -> PU (Maybe a)
HXT.xpAttrImplied String
retireKillerMovesAfterTag PU SearchDepth
HXT.xpInt
	 ) (
		SearchOptions -> PreferMovesTowardsCentre
getTrapRepeatedPositions SearchOptions
def PreferMovesTowardsCentre
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. String -> PU a -> PU a
HXT.xpAttr String
trapRepeatedPositionsTag PU PreferMovesTowardsCentre
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (
		SearchOptions -> PreferMovesTowardsCentre
getUsePondering SearchOptions
def PreferMovesTowardsCentre
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String
-> PU PreferMovesTowardsCentre -> PU PreferMovesTowardsCentre
forall a. String -> PU a -> PU a
HXT.xpAttr String
usePonderingTag PU PreferMovesTowardsCentre
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) (
		PU (SearchDepth, SearchDepth) -> PU MaybeUseTranspositions
forall a. PU a -> PU (Maybe a)
HXT.xpOption (PU (SearchDepth, SearchDepth) -> PU MaybeUseTranspositions)
-> (PU (SearchDepth, SearchDepth) -> PU (SearchDepth, SearchDepth))
-> PU (SearchDepth, SearchDepth)
-> PU MaybeUseTranspositions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PU (SearchDepth, SearchDepth) -> PU (SearchDepth, SearchDepth)
forall a. String -> PU a -> PU a
HXT.xpElem String
"transpositions" (PU (SearchDepth, SearchDepth) -> PU MaybeUseTranspositions)
-> PU (SearchDepth, SearchDepth) -> PU MaybeUseTranspositions
forall a b. (a -> b) -> a -> b
$ String -> PU SearchDepth -> PU SearchDepth
forall a. String -> PU a -> PU a
HXT.xpAttr String
retireTranspositionsAfterTag PU SearchDepth
HXT.xpInt PU SearchDepth -> PU SearchDepth -> PU (SearchDepth, SearchDepth)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU SearchDepth -> PU SearchDepth
forall a. String -> PU a -> PU a
HXT.xpAttr String
minimumTranspositionSearchDepthTag PU SearchDepth
HXT.xpInt
	 ) PU StandardOpeningOptions
forall a. XmlPickler a => PU a
HXT.xpickle {-standardOpeningOptions-} (
		String
-> PU SearchDepthByLogicalColour -> PU SearchDepthByLogicalColour
forall a. String -> PU a -> PU a
HXT.xpElem String
searchDepthByLogicalColourTag (PU SearchDepthByLogicalColour -> PU SearchDepthByLogicalColour)
-> (PU (LogicalColour, SearchDepth)
    -> PU SearchDepthByLogicalColour)
-> PU (LogicalColour, SearchDepth)
-> PU SearchDepthByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(LogicalColour, SearchDepth)] -> SearchDepthByLogicalColour,
 SearchDepthByLogicalColour -> [(LogicalColour, SearchDepth)])
-> PU [(LogicalColour, SearchDepth)]
-> PU SearchDepthByLogicalColour
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
			[(LogicalColour, SearchDepth)] -> SearchDepthByLogicalColour
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList,	-- Construct from a List.
			SearchDepthByLogicalColour -> [(LogicalColour, SearchDepth)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList		-- Deconstruct to a List.
		) (PU [(LogicalColour, SearchDepth)]
 -> PU SearchDepthByLogicalColour)
-> (PU (LogicalColour, SearchDepth)
    -> PU [(LogicalColour, SearchDepth)])
-> PU (LogicalColour, SearchDepth)
-> PU SearchDepthByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PU (LogicalColour, SearchDepth)
-> PU [(LogicalColour, SearchDepth)]
forall a. PU a -> PU [a]
HXT.xpList {-potentially null-} (PU (LogicalColour, SearchDepth)
 -> PU [(LogicalColour, SearchDepth)])
-> (PU (LogicalColour, SearchDepth)
    -> PU (LogicalColour, SearchDepth))
-> PU (LogicalColour, SearchDepth)
-> PU [(LogicalColour, SearchDepth)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PU (LogicalColour, SearchDepth)
-> PU (LogicalColour, SearchDepth)
forall a. String -> PU a -> PU a
HXT.xpElem String
"byLogicalColour" (PU (LogicalColour, SearchDepth) -> PU SearchDepthByLogicalColour)
-> PU (LogicalColour, SearchDepth) -> PU SearchDepthByLogicalColour
forall a b. (a -> b) -> a -> b
$ PU LogicalColour
forall a. XmlPickler a => PU a
HXT.xpickle {-LogicalColour-} PU LogicalColour
-> PU SearchDepth -> PU (LogicalColour, SearchDepth)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU SearchDepth -> PU SearchDepth
forall a. String -> PU a -> PU a
HXT.xpAttr String
searchDepthTag PU SearchDepth
HXT.xpInt
	 ) where
		def :: SearchOptions
def	= SearchOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkSearchOptions
	:: PreferMovesTowardsCentre
	-> SortOnStandardOpeningMoveFrequency
	-> Maybe Attribute.CaptureMoveSortAlgorithm.CaptureMoveSortAlgorithm
	-> Maybe HammingDistance	-- ^ The optional lower bound on the Hamming-distance between the random numbers used to compose Zobrist hashes from /position/s.
	-> MaybeRetireAfterNMoves	-- ^ The number of full moves back from the current position, after which to retire killer-moves.
	-> TrapRepeatedPositions
	-> UsePondering
	-> MaybeUseTranspositions	-- ^ The number of full moves after which to retire transpositions, & the search-depth beneath which transpositions aren't recorded.
	-> Input.StandardOpeningOptions.StandardOpeningOptions
	-> SearchDepthByLogicalColour
	-> SearchOptions
mkSearchOptions :: PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> Maybe CaptureMoveSortAlgorithm
-> Maybe SearchDepth
-> Maybe SearchDepth
-> PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> MaybeUseTranspositions
-> StandardOpeningOptions
-> SearchDepthByLogicalColour
-> SearchOptions
mkSearchOptions PreferMovesTowardsCentre
preferMovesTowardsCentre PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm Maybe SearchDepth
maybeMinimumHammingDistance Maybe SearchDepth
maybeRetireKillerMovesAfter PreferMovesTowardsCentre
trapRepeatedPositions PreferMovesTowardsCentre
usePondering MaybeUseTranspositions
maybeUseTranspositions StandardOpeningOptions
standardOpeningOptions SearchDepthByLogicalColour
searchDepthByLogicalColour
	| Just SearchDepth
minimumHammingDistance		<- Maybe SearchDepth
maybeMinimumHammingDistance
	, SearchDepth
minimumHammingDistance SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
< SearchDepth
1	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
minimumHammingDistanceTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
minimumHammingDistance String
" must exceed zero."
	| Just SearchDepth
retireKillerMovesAfter		<- Maybe SearchDepth
maybeRetireKillerMovesAfter
	, SearchDepth
retireKillerMovesAfter SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
< SearchDepth
0	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
retireKillerMovesAfterTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
retireKillerMovesAfter String
" can't be negative."
	| let nAutomatedPlayers :: SearchDepth
nAutomatedPlayers	= SearchDepthByLogicalColour -> SearchDepth
forall k a. Map k a -> SearchDepth
Data.Map.size SearchDepthByLogicalColour
searchDepthByLogicalColour
	, PreferMovesTowardsCentre
usePondering PreferMovesTowardsCentre
-> PreferMovesTowardsCentre -> PreferMovesTowardsCentre
&& SearchDepth
nAutomatedPlayers SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Eq a => a -> a -> PreferMovesTowardsCentre
/= SearchDepth
1
	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\tpondering is pointless unless there's an automated player who can use the unused CPU-time during a manual player's move, but there're " (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
nAutomatedPlayers String
" automated players."
	| Just (SearchDepth
retireTranspositionsAfter, SearchDepth
_)	<- MaybeUseTranspositions
maybeUseTranspositions
	, SearchDepth
retireTranspositionsAfter SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
< SearchDepth
0	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
retireTranspositionsAfterTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
retireTranspositionsAfter String
" can't be negative."
	| Just (SearchDepth
_, SearchDepth
minimumTranspositionSearchDepth)	<- MaybeUseTranspositions
maybeUseTranspositions
	, SearchDepth
minimumTranspositionSearchDepth SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
< SearchDepth
1	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
minimumTranspositionSearchDepthTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
minimumTranspositionSearchDepth String
" must exceed zero."
	| Just (SearchDepth
_, SearchDepth
minimumTranspositionSearchDepth)	<- MaybeUseTranspositions
maybeUseTranspositions
	, PreferMovesTowardsCentre -> PreferMovesTowardsCentre
not (PreferMovesTowardsCentre -> PreferMovesTowardsCentre)
-> PreferMovesTowardsCentre -> PreferMovesTowardsCentre
forall a b. (a -> b) -> a -> b
$ SearchDepthByLogicalColour -> PreferMovesTowardsCentre
forall k a. Map k a -> PreferMovesTowardsCentre
Data.Map.null SearchDepthByLogicalColour
searchDepthByLogicalColour
	, (SearchDepth -> PreferMovesTowardsCentre)
-> SearchDepthByLogicalColour -> PreferMovesTowardsCentre
forall (t :: * -> *) a.
Foldable t =>
(a -> PreferMovesTowardsCentre) -> t a -> PreferMovesTowardsCentre
Data.Foldable.all (
		SearchDepth
minimumTranspositionSearchDepth SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
>
	) SearchDepthByLogicalColour
searchDepthByLogicalColour	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
minimumTranspositionSearchDepthTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
minimumTranspositionSearchDepth ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" exceeds " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
searchDepthTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [(LogicalColour, SearchDepth)] -> ShowS
forall a. Show a => a -> ShowS
shows (SearchDepthByLogicalColour -> [(LogicalColour, SearchDepth)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList SearchDepthByLogicalColour
searchDepthByLogicalColour) String
"."
	| (SearchDepth -> PreferMovesTowardsCentre)
-> SearchDepthByLogicalColour -> PreferMovesTowardsCentre
forall (t :: * -> *) a.
Foldable t =>
(a -> PreferMovesTowardsCentre) -> t a -> PreferMovesTowardsCentre
Data.Foldable.any (
		SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
< SearchDepth
minimumSearchDepth
	) SearchDepthByLogicalColour
searchDepthByLogicalColour	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.mkSearchOptions:\t" (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
searchDepthTag String
" must be positive."
	| PreferMovesTowardsCentre
otherwise	= MkSearchOptions :: PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> Maybe CaptureMoveSortAlgorithm
-> Maybe SearchDepth
-> Maybe SearchDepth
-> PreferMovesTowardsCentre
-> PreferMovesTowardsCentre
-> MaybeUseTranspositions
-> StandardOpeningOptions
-> SearchDepthByLogicalColour
-> SearchOptions
MkSearchOptions {
		getPreferMovesTowardsCentre :: PreferMovesTowardsCentre
getPreferMovesTowardsCentre		= PreferMovesTowardsCentre
preferMovesTowardsCentre,
		getSortOnStandardOpeningMoveFrequency :: PreferMovesTowardsCentre
getSortOnStandardOpeningMoveFrequency	= PreferMovesTowardsCentre
sortOnStandardOpeningMoveFrequency,
		getMaybeCaptureMoveSortAlgorithm :: Maybe CaptureMoveSortAlgorithm
getMaybeCaptureMoveSortAlgorithm	= Maybe CaptureMoveSortAlgorithm
maybeCaptureMoveSortAlgorithm,
		getMaybeMinimumHammingDistance :: Maybe SearchDepth
getMaybeMinimumHammingDistance		= Maybe SearchDepth
maybeMinimumHammingDistance,
		getMaybeRetireKillerMovesAfter :: Maybe SearchDepth
getMaybeRetireKillerMovesAfter		= Maybe SearchDepth
maybeRetireKillerMovesAfter,
		getTrapRepeatedPositions :: PreferMovesTowardsCentre
getTrapRepeatedPositions		= PreferMovesTowardsCentre
trapRepeatedPositions,
		getUsePondering :: PreferMovesTowardsCentre
getUsePondering				= PreferMovesTowardsCentre
usePondering,
		getMaybeUseTranspositions :: MaybeUseTranspositions
getMaybeUseTranspositions		= MaybeUseTranspositions
maybeUseTranspositions,
		getStandardOpeningOptions :: StandardOpeningOptions
getStandardOpeningOptions		= StandardOpeningOptions
standardOpeningOptions,
		getSearchDepthByLogicalColour :: SearchDepthByLogicalColour
getSearchDepthByLogicalColour		= SearchDepthByLogicalColour
searchDepthByLogicalColour
	}

-- | Get either player's search-depth, using a default value when none are defined.
getSearchDepth :: SearchOptions -> SearchDepth
getSearchDepth :: SearchOptions -> SearchDepth
getSearchDepth MkSearchOptions { getSearchDepthByLogicalColour :: SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour = SearchDepthByLogicalColour
searchDepthByLogicalColour }	= SearchDepth -> Maybe SearchDepth -> SearchDepth
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe SearchDepth
defaultSearchDepth (Maybe SearchDepth -> SearchDepth)
-> ([SearchDepth] -> Maybe SearchDepth)
-> [SearchDepth]
-> SearchDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SearchDepth] -> Maybe SearchDepth
forall a. [a] -> Maybe a
Data.Maybe.listToMaybe ([SearchDepth] -> SearchDepth) -> [SearchDepth] -> SearchDepth
forall a b. (a -> b) -> a -> b
$ SearchDepthByLogicalColour -> [SearchDepth]
forall k a. Map k a -> [a]
Data.Map.elems SearchDepthByLogicalColour
searchDepthByLogicalColour	-- Manual players don't have a searchDepth, so use the opponent's settings.

-- | Self-documentation.
type RecordKillerMoves	= Bool

-- | Whether killer-moves are to be recorded.
recordKillerMoves :: SearchOptions -> RecordKillerMoves
recordKillerMoves :: SearchOptions -> PreferMovesTowardsCentre
recordKillerMoves MkSearchOptions { getMaybeRetireKillerMovesAfter :: SearchOptions -> Maybe SearchDepth
getMaybeRetireKillerMovesAfter = Maybe SearchDepth
maybeRetireKillerMovesAfter }	= Maybe SearchDepth -> PreferMovesTowardsCentre
forall a. Maybe a -> PreferMovesTowardsCentre
Data.Maybe.isJust Maybe SearchDepth
maybeRetireKillerMovesAfter

-- | When to retire transpositions.
maybeRetireTranspositionsAfter :: SearchOptions -> MaybeRetireAfterNMoves
maybeRetireTranspositionsAfter :: SearchOptions -> Maybe SearchDepth
maybeRetireTranspositionsAfter MkSearchOptions { getMaybeUseTranspositions :: SearchOptions -> MaybeUseTranspositions
getMaybeUseTranspositions = MaybeUseTranspositions
maybeUseTranspositions }	= ((SearchDepth, SearchDepth) -> SearchDepth)
-> MaybeUseTranspositions -> Maybe SearchDepth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SearchDepth, SearchDepth) -> SearchDepth
forall a b. (a, b) -> a
fst MaybeUseTranspositions
maybeUseTranspositions

-- | The search-depth beneath which transpositions aren't recorded.
maybeMinimumTranspositionSearchDepth :: SearchOptions -> Maybe SearchDepth
maybeMinimumTranspositionSearchDepth :: SearchOptions -> Maybe SearchDepth
maybeMinimumTranspositionSearchDepth MkSearchOptions { getMaybeUseTranspositions :: SearchOptions -> MaybeUseTranspositions
getMaybeUseTranspositions = MaybeUseTranspositions
maybeUseTranspositions }	= ((SearchDepth, SearchDepth) -> SearchDepth)
-> MaybeUseTranspositions -> Maybe SearchDepth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SearchDepth, SearchDepth) -> SearchDepth
forall a b. (a, b) -> b
snd MaybeUseTranspositions
maybeUseTranspositions

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

-- | Mutator.
setSearchDepth :: SearchDepth -> Transformation
setSearchDepth :: SearchDepth -> Transformation
setSearchDepth SearchDepth
searchDepth searchOptions :: SearchOptions
searchOptions@MkSearchOptions { getSearchDepthByLogicalColour :: SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour = SearchDepthByLogicalColour
searchDepthByLogicalColour }
	| SearchDepth
searchDepth SearchDepth -> SearchDepth -> PreferMovesTowardsCentre
forall a. Ord a => a -> a -> PreferMovesTowardsCentre
< SearchDepth
minimumSearchDepth	= Exception -> SearchOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SearchOptions)
-> (String -> Exception) -> String -> SearchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.SearchOptions.setSearchDepth:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
searchDepthTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> SearchOptions) -> String -> SearchOptions
forall a b. (a -> b) -> a -> b
$ SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
searchDepth String
" must be positive."
	| PreferMovesTowardsCentre
otherwise	= SearchOptions
searchOptions { getSearchDepthByLogicalColour :: SearchDepthByLogicalColour
getSearchDepthByLogicalColour = (SearchDepth -> SearchDepth)
-> SearchDepthByLogicalColour -> SearchDepthByLogicalColour
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map (SearchDepth -> SearchDepth -> SearchDepth
forall a b. a -> b -> a
const SearchDepth
searchDepth) SearchDepthByLogicalColour
searchDepthByLogicalColour }

-- | Swap the /logical colour/ associated with any /searchDepth/ currently assigned.
swapSearchDepth :: Transformation
swapSearchDepth :: Transformation
swapSearchDepth searchOptions :: SearchOptions
searchOptions@MkSearchOptions {
	getSearchDepthByLogicalColour :: SearchOptions -> SearchDepthByLogicalColour
getSearchDepthByLogicalColour	= SearchDepthByLogicalColour
searchDepthByLogicalColour
} = SearchOptions
searchOptions {
	getSearchDepthByLogicalColour :: SearchDepthByLogicalColour
getSearchDepthByLogicalColour	= [(LogicalColour, SearchDepth)] -> SearchDepthByLogicalColour
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList ([(LogicalColour, SearchDepth)] -> SearchDepthByLogicalColour)
-> ([(LogicalColour, SearchDepth)]
    -> [(LogicalColour, SearchDepth)])
-> [(LogicalColour, SearchDepth)]
-> SearchDepthByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColour, SearchDepth) -> (LogicalColour, SearchDepth))
-> [(LogicalColour, SearchDepth)] -> [(LogicalColour, SearchDepth)]
forall a b. (a -> b) -> [a] -> [b]
map ((LogicalColour -> LogicalColour)
-> (LogicalColour, SearchDepth) -> (LogicalColour, SearchDepth)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite) ([(LogicalColour, SearchDepth)] -> SearchDepthByLogicalColour)
-> [(LogicalColour, SearchDepth)] -> SearchDepthByLogicalColour
forall a b. (a -> b) -> a -> b
$ SearchDepthByLogicalColour -> [(LogicalColour, SearchDepth)]
forall k a. Map k a -> [(k, a)]
Data.Map.toDescList SearchDepthByLogicalColour
searchDepthByLogicalColour
}

-- | Self-documentation.
type Reader	= Control.Monad.Reader.Reader SearchOptions