module BishBosh.Input.SearchOptions(
SearchDepth,
PreferMovesTowardsCentre,
SortOnStandardOpeningMoveFrequency,
HammingDistance,
MaybeRetireAfterNMoves,
TrapRepeatedPositions,
MaybeUseTranspositions,
Reader,
SearchOptions(
getPreferMovesTowardsCentre,
getSortOnStandardOpeningMoveFrequency,
getMaybeCaptureMoveSortAlgorithm,
getMaybeMinimumHammingDistance,
getMaybeRetireKillerMovesAfter,
getTrapRepeatedPositions,
getUsePondering,
getMaybeUseTranspositions,
getStandardOpeningOptions,
getSearchDepthByLogicalColour
),
tag,
searchDepthTag,
minimumSearchDepth,
defaultSearchDepth,
mkSearchOptions,
getSearchDepth,
maybeRetireTranspositionsAfter,
maybeMinimumTranspositionSearchDepth,
setSearchDepth,
swapSearchDepth,
recordKillerMoves
) where
import BishBosh.Data.Bool()
import BishBosh.Data.Integral()
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
tag :: String
tag :: String
tag = String
"searchOptions"
preferMovesTowardsCentreTag :: String
preferMovesTowardsCentreTag :: String
preferMovesTowardsCentreTag = String
"preferMovesTowardsCentre"
sortOnStandardOpeningMoveFrequencyTag :: String
sortOnStandardOpeningMoveFrequencyTag :: String
sortOnStandardOpeningMoveFrequencyTag = String
"sortOnStandardOpeningMoveFrequency"
minimumHammingDistanceTag :: String
minimumHammingDistanceTag :: String
minimumHammingDistanceTag = String
"minimumHammingDistance"
retireKillerMovesAfterTag :: String
retireKillerMovesAfterTag :: String
retireKillerMovesAfterTag = String
"retireKillerMovesAfter"
trapRepeatedPositionsTag :: String
trapRepeatedPositionsTag :: String
trapRepeatedPositionsTag = String
"trapRepeatedPositions"
usePonderingTag :: String
usePonderingTag :: String
usePonderingTag = String
"usePondering"
retireTranspositionsAfterTag :: String
retireTranspositionsAfterTag :: String
retireTranspositionsAfterTag = String
"retireTranspositionsAfter"
minimumTranspositionSearchDepthTag :: String
minimumTranspositionSearchDepthTag :: String
minimumTranspositionSearchDepthTag = String
"minimumTranspositionSearchDepth"
searchDepthTag :: String
searchDepthTag :: String
searchDepthTag = String
"searchDepth"
searchDepthByLogicalColourTag :: String
searchDepthByLogicalColourTag :: String
searchDepthByLogicalColourTag = String -> ShowS
showString String
searchDepthTag String
"ByLogicalColour"
type SearchDepth = Component.Move.NMoves
minimumSearchDepth :: SearchDepth
minimumSearchDepth :: SearchDepth
minimumSearchDepth = SearchDepth
1
defaultSearchDepth :: SearchDepth
defaultSearchDepth :: SearchDepth
defaultSearchDepth = SearchDepth
4
type PreferMovesTowardsCentre = Bool
type SortOnStandardOpeningMoveFrequency = Bool
type HammingDistance = Int
type MaybeRetireAfterNMoves = Maybe Component.Move.NMoves
type TrapRepeatedPositions = Bool
type UsePondering = Bool
type MaybeUseTranspositions = Maybe (Component.Move.NMoves, SearchDepth)
type SearchDepthByLogicalColour = Data.Map.Map Attribute.LogicalColour.LogicalColour SearchDepth
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
}
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,
\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
)
) (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
) (
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
) (
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
) (
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
) (
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 (
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,
SearchDepthByLogicalColour -> [(LogicalColour, SearchDepth)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList
) (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 (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 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
mkSearchOptions
:: PreferMovesTowardsCentre
-> SortOnStandardOpeningMoveFrequency
-> Maybe Attribute.CaptureMoveSortAlgorithm.CaptureMoveSortAlgorithm
-> Maybe HammingDistance
-> MaybeRetireAfterNMoves
-> TrapRepeatedPositions
-> UsePondering
-> MaybeUseTranspositions
-> 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
}
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
type RecordKillerMoves = Bool
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
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
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
type Transformation = SearchOptions -> SearchOptions
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 }
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
}
type Reader = Control.Monad.Reader.Reader SearchOptions