bishbosh 0.1.1.0 → 0.1.2.0

raw patch · 164 files changed

+4161/−5205 lines, 164 filesdep ~QuickCheckdep ~arraydep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, array, base, containers, data-default, deepseq, extra, factory, hxt, hxt-relaxng, mtl, parsec, polyparse, toolshed, unix

API changes (from Hackage documentation)

Files

• README.markdown +2/−1
• bishbosh.cabal +132/−154
• bishbosh.spec +1/−1
• changelog.markdown +41/−11
• config/CECP/bishbosh_black.xml +2/−1
• config/Raw/bishbosh_black.xml +2/−1
• config/Raw/bishbosh_black_figurine.xml +45/−0
• config/Raw/bishbosh_both.xml +2/−1
• config/Raw/bishbosh_duel_black.xml +4/−3
• config/Raw/bishbosh_duel_white.xml +4/−3
• config/Raw/bishbosh_prof.xml +2/−1
• config/Raw/bishbosh_white.xml +2/−1
• config/bishbosh.dtd +4/−0
• config/bishbosh.rng +8/−0
• makefile +22/−17
• man/man1/bishbosh.1 +1/−1
• man/man1/duel.1 +8/−0
• man/man5/bishbosh.5 +4/−0
• src-exe/BishBosh/Play.hs +45/−38
• src-exe/BishBosh/State/PlayState.hs +43/−67
• src-exe/BishBosh/Text/ShowColouredPrefix.hs +0/−52
• src-exe/BishBosh/UI/CECP.hs +79/−108
• src-exe/BishBosh/UI/Raw.hs +91/−116
• src-exe/Duel/Process/Intermediary.hs +53/−26
• src-exe/Main.hs +10/−7
• src-lib/BishBosh/Attribute/ANSIColourCode.hs +76/−0
• src-lib/BishBosh/Attribute/ColourScheme.hs +4/−3
• src-lib/BishBosh/Attribute/Direction.hs +7/−13
• src-lib/BishBosh/Attribute/MoveType.hs +9/−0
• src-lib/BishBosh/Attribute/PhysicalColour.hs +12/−37
• src-lib/BishBosh/Attribute/Rank.hs +4/−4
• src-lib/BishBosh/Cartesian/Abscissa.hs +38/−40
• src-lib/BishBosh/Cartesian/Coordinates.hs +102/−256
• src-lib/BishBosh/Cartesian/Ordinate.hs +22/−52
• src-lib/BishBosh/Cartesian/Vector.hs +96/−122
• src-lib/BishBosh/Component/Accountant.hs +42/−0
• src-lib/BishBosh/Component/CastlingMove.hs +14/−47
• src-lib/BishBosh/Component/EitherQualifiedMove.hs +4/−4
• src-lib/BishBosh/Component/Move.hs +31/−49
• src-lib/BishBosh/Component/Piece.hs +57/−95
• src-lib/BishBosh/Component/PieceSquareByCoordinatesByRank.hs +23/−96
• src-lib/BishBosh/Component/QualifiedMove.hs +7/−14
• src-lib/BishBosh/Component/Turn.hs +17/−28
• src-lib/BishBosh/Component/Zobrist.hs +16/−71
• src-lib/BishBosh/ContextualNotation/PGN.hs +33/−97
• src-lib/BishBosh/ContextualNotation/PGNComment.hs +5/−3
• src-lib/BishBosh/ContextualNotation/PGNDatabase.hs +22/−44
• src-lib/BishBosh/ContextualNotation/PositionHashQualifiedMoveTree.hs +122/−126
• src-lib/BishBosh/ContextualNotation/QualifiedMoveForest.hs +31/−38
• src-lib/BishBosh/ContextualNotation/StandardAlgebraic.hs +34/−82
• src-lib/BishBosh/Data/Enum.hs +0/−34
• src-lib/BishBosh/Data/Foldable.hs +4/−4
• src-lib/BishBosh/Evaluation/Fitness.hs +76/−105
• src-lib/BishBosh/Evaluation/PositionHashQuantifiedGameTree.hs +49/−57
• src-lib/BishBosh/Evaluation/QuantifiedGame.hs +19/−27
• src-lib/BishBosh/Input/CriteriaWeights.hs +0/−81
• src-lib/BishBosh/Input/EvaluationOptions.hs +23/−48
• src-lib/BishBosh/Input/IOOptions.hs +48/−19
• src-lib/BishBosh/Input/NativeUIOptions.hs +36/−12
• src-lib/BishBosh/Input/Options.hs +24/−35
• src-lib/BishBosh/Input/PieceSquareTable.hs +28/−39
• src-lib/BishBosh/Input/SearchOptions.hs +16/−15
• src-lib/BishBosh/Input/StandardOpeningOptions.hs +39/−37
• src-lib/BishBosh/Model/Game.hs +128/−391
• src-lib/BishBosh/Model/GameTree.hs +27/−48
• src-lib/BishBosh/Model/MoveFrequency.hs +15/−9
• src-lib/BishBosh/Model/PositionHashTree.hs +9/−14
• src-lib/BishBosh/Notation/Figurine.hs +61/−0
• src-lib/BishBosh/Notation/ICCFNumeric.hs +21/−50
• src-lib/BishBosh/Notation/MoveNotation.hs +17/−20
• src-lib/BishBosh/Notation/Notation.hs +157/−0
• src-lib/BishBosh/Notation/PureCoordinate.hs +43/−128
• src-lib/BishBosh/Notation/Smith.hs +38/−50
• src-lib/BishBosh/Property/Empty.hs +11/−7
• src-lib/BishBosh/Property/ExtendedPositionDescription.hs +20/−4
• src-lib/BishBosh/Property/ForsythEdwards.hs +10/−4
• src-lib/BishBosh/Property/Null.hs +1/−1
• src-lib/BishBosh/Property/Opposable.hs +6/−1
• src-lib/BishBosh/Search/AlphaBeta.hs +31/−62
• src-lib/BishBosh/Search/DynamicMoveData.hs +10/−10
• src-lib/BishBosh/Search/KillerMoves.hs +13/−13
• src-lib/BishBosh/Search/Search.hs +16/−31
• src-lib/BishBosh/Search/SearchState.hs +9/−9
• src-lib/BishBosh/Search/Transpositions.hs +7/−6
• src-lib/BishBosh/State/Board.hs +92/−229
• src-lib/BishBosh/State/CastleableRooksByLogicalColour.hs +53/−95
• src-lib/BishBosh/State/CoordinatesByRankByLogicalColour.hs +58/−92
• src-lib/BishBosh/State/EnPassantAbscissa.hs +12/−19
• src-lib/BishBosh/State/InstancesByPosition.hs +32/−20
• src-lib/BishBosh/State/MaybePieceByCoordinates.hs +120/−302
• src-lib/BishBosh/State/Position.hs +18/−40
• src-lib/BishBosh/StateProperty/Hashable.hs +64/−0
• src-lib/BishBosh/StateProperty/Mutator.hs +21/−21
• src-lib/BishBosh/StateProperty/Seeker.hs +58/−9
• src-lib/BishBosh/Text/Poly.hs +4/−2
• src-lib/BishBosh/Text/ShowColouredPrefix.hs +53/−0
• src-lib/BishBosh/Time/GameClock.hs +3/−3
• src-lib/BishBosh/Type/Count.hs +14/−3
• src-lib/BishBosh/Type/Length.hs +35/−18
• src-lib/BishBosh/Type/Mass.hs +11/−3
• src-lib/BishBosh/UI/Command.hs +32/−26
• src-lib/BishBosh/UI/ReportObject.hs +7/−10
• src-lib/BishBosh/UI/SetObject.hs +33/−13
• src-test/BishBosh/Test/HUnit/Cartesian/Coordinates.hs +5/−12
• src-test/BishBosh/Test/HUnit/Cartesian/Vector.hs +4/−9
• src-test/BishBosh/Test/HUnit/Component/CastlingMove.hs +3/−4
• src-test/BishBosh/Test/HUnit/Component/Move.hs +1/−8
• src-test/BishBosh/Test/HUnit/Component/Piece.hs +12/−14
• src-test/BishBosh/Test/HUnit/Component/Zobrist.hs +4/−5
• src-test/BishBosh/Test/HUnit/ContextualNotation/PGN.hs +11/−14
• src-test/BishBosh/Test/HUnit/ContextualNotation/PositionHashQualifiedMoveTree.hs +56/−43
• src-test/BishBosh/Test/HUnit/ContextualNotation/StandardAlgebraic.hs +9/−6
• src-test/BishBosh/Test/HUnit/Evaluation/Fitness.hs +12/−13
• src-test/BishBosh/Test/HUnit/Input/Options.hs +1/−2
• src-test/BishBosh/Test/HUnit/Model/Game.hs +15/−23
• src-test/BishBosh/Test/HUnit/Model/GameTree.hs +3/−9
• src-test/BishBosh/Test/HUnit/Search/Search.hs +46/−39
• src-test/BishBosh/Test/HUnit/State/Board.hs +95/−84
• src-test/BishBosh/Test/HUnit/Time/GameClock.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Attribute/MoveType.hs +6/−0
• src-test/BishBosh/Test/QuickCheck/Cartesian/Coordinates.hs +17/−69
• src-test/BishBosh/Test/QuickCheck/Cartesian/Vector.hs +27/−23
• src-test/BishBosh/Test/QuickCheck/Component/Move.hs +11/−27
• src-test/BishBosh/Test/QuickCheck/Component/Piece.hs +5/−17
• src-test/BishBosh/Test/QuickCheck/Component/QualifiedMove.hs +5/−18
• src-test/BishBosh/Test/QuickCheck/Component/Turn.hs +8/−20
• src-test/BishBosh/Test/QuickCheck/Component/Zobrist.hs +7/−63
• src-test/BishBosh/Test/QuickCheck/ContextualNotation/PGN.hs +18/−27
• src-test/BishBosh/Test/QuickCheck/ContextualNotation/PGNComment.hs +8/−4
• src-test/BishBosh/Test/QuickCheck/ContextualNotation/PositionHashQualifiedMoveTree.hs +4/−19
• src-test/BishBosh/Test/QuickCheck/ContextualNotation/QualifiedMoveForest.hs +3/−18
• src-test/BishBosh/Test/QuickCheck/ContextualNotation/StandardAlgebraic.hs +10/−6
• src-test/BishBosh/Test/QuickCheck/Evaluation/PositionHashQuantifiedGameTree.hs +6/−29
• src-test/BishBosh/Test/QuickCheck/Input/EvaluationOptions.hs +20/−31
• src-test/BishBosh/Test/QuickCheck/Input/NativeUIOptions.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Input/Options.hs +15/−12
• src-test/BishBosh/Test/QuickCheck/Input/PieceSquareTable.hs +5/−11
• src-test/BishBosh/Test/QuickCheck/Input/SearchOptions.hs +4/−4
• src-test/BishBosh/Test/QuickCheck/Input/StandardOpeningOptions.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Model/Game.hs +82/−83
• src-test/BishBosh/Test/QuickCheck/Model/GameTree.hs +6/−13
• src-test/BishBosh/Test/QuickCheck/Model/MoveFrequency.hs +4/−4
• src-test/BishBosh/Test/QuickCheck/Notation/Figurine.hs +43/−0
• src-test/BishBosh/Test/QuickCheck/Notation/ICCFNumeric.hs +5/−18
• src-test/BishBosh/Test/QuickCheck/Notation/MoveNotation.hs +46/−1
• src-test/BishBosh/Test/QuickCheck/Notation/PureCoordinate.hs +5/−18
• src-test/BishBosh/Test/QuickCheck/Notation/Smith.hs +4/−17
• src-test/BishBosh/Test/QuickCheck/Search/KillerMoves.hs +5/−15
• src-test/BishBosh/Test/QuickCheck/Search/Search.hs +7/−1
• src-test/BishBosh/Test/QuickCheck/Search/SearchState.hs +8/−17
• src-test/BishBosh/Test/QuickCheck/State/Board.hs +40/−54
• src-test/BishBosh/Test/QuickCheck/State/CastleableRooksByLogicalColour.hs +11/−22
• src-test/BishBosh/Test/QuickCheck/State/InstancesByPosition.hs +3/−3
• src-test/BishBosh/Test/QuickCheck/State/Position.hs +2/−2
• src-test/BishBosh/Test/QuickCheck/State/TurnsByLogicalColour.hs +7/−9
• src-test/BishBosh/Test/QuickCheck/StateProperty/Censor.hs +12/−12
• src-test/BishBosh/Test/QuickCheck/StateProperty/Hashable.hs +78/−0
• src-test/BishBosh/Test/QuickCheck/StateProperty/Seeker.hs +72/−0
• src-test/BishBosh/Test/QuickCheck/Type/Count.hs +36/−0
• src-test/BishBosh/Test/QuickCheck/Type/Length.hs +41/−0
• src-test/BishBosh/Test/QuickCheck/UI/Command.hs +2/−9
• src-test/BishBosh/Test/QuickCheck/UI/SetObject.hs +5/−3
• src-test/HUnit.hs +3/−9
• src-test/QuickCheck.hs +8/−2

@@ -2,8 +2,9 @@  [![Build Status](https://travis-ci.com/functionalley/BishBosh.svg?branch=master)](https://travis-ci.com/functionalley/BishBosh) [![Hackage](https://img.shields.io/hackage/v/bishbosh.svg)](https://hackage.haskell.org/package/bishbosh)+[![GitHub top language](https://img.shields.io/github/languages/top/functionalley/BishBosh?color=yellow)](https://github.com/functionalley/BishBosh)+[![GitHub code size in bytes](https://img.shields.io/github/languages/code-size/functionalley/BishBosh?color=violet)](https://github.com/functionalley/BishBosh) [![License: GPL v3](https://img.shields.io/badge/License-GPL%20v3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0)-[![Haskell](https://b.repl.ca/v1/language-haskell-yellow.png)](https://haskell.org)  This is "**BishBosh**", a chess-game which can be rendered in a terminal (emulator) using raw ASCII, or used as an engine by [xboard](https://www.gnu.org/software/xboard/). 

@@ -16,7 +16,7 @@ -- along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.  Name:		bishbosh-Version:	0.1.1.0+Version:	0.1.2.0 Copyright:	(C) 2018 Dr. Alistair Ward License:	GPL-3.0-or-later License-file:	LICENSE@@ -24,9 +24,9 @@ Stability:	stable Synopsis:	Plays chess. Build-type:	Simple-Description:	A chess-game which can be rendered in a terminal (emulator) in raw ASCII, or used as an engine by xboard.+Description:	A chess-game which can be rendered in a terminal (emulator) in raw ASCII, or used as an engine by @xboard@. Category:	Game-Tested-with:	GHC == 8.0, GHC == 8.4, GHC == 8.8, GHC == 8.10+Tested-with:	GHC == 8.0, GHC == 8.2, GHC == 8.4, GHC == 8.6, GHC == 8.8, GHC == 8.10 Homepage:	https://functionalley.com/BishBosh/bishbosh.html Maintainer:	mailto:bishbosh@functionalley.com Bug-reports:	mailto:bishbosh@functionalley.com@@ -64,14 +64,6 @@     Default:		False  -- Automatically disabled when the required package isn't available.--- To access Parsec's more precise error-messages, manually disable using one of:---	runhaskell Setup configure -f -polyparse --verbose;---	stack build --flag 'bishbosh:-polyparse' --cabal-verbose;-flag polyparse-    Description:	Link with package "polyparse" when available, rather than "parsec".-    Default:		True---- Automatically disabled when the required package isn't available. -- To force validation of the XML-configuration against the packaged DTD, manually disable using one of: --	runhaskell Setup configure -f -hxtrelaxng --verbose; --	stack build --flag 'bishbosh:-hxtrelaxng' --cabal-verbose;@@ -80,6 +72,7 @@     Default:		True  -- Whether to use narrower numerical types than machine-defaults. CAVEAT: this option increases both the space allocated & the execution-time.+-- CAVEAT: incompatble with the flag 'precision'. flag narrownumbers     Description:	Use narrow numerical types.     Manual:		True@@ -91,6 +84,20 @@     Manual:		True     Default:		False +-- Automatically disabled when the required package isn't available.+-- To access Parsec's more precise error-messages, manually disable using one of:+--	runhaskell Setup configure -f -polyparse --verbose;+--	stack build --flag 'bishbosh:-polyparse' --cabal-verbose;+flag polyparse+    Description:	Link with package "polyparse" when available, rather than "parsec".+    Default:		True++-- Whether to use precise (rational) types rather than floating-point. CAVEAT: incompatible with 'narrownumbers'.+flag precision+    Description:	Use precise numerical types. CAVEAT: this is incompatible with either 'unboxedarrays' or 'narrownumbers'.+    Manual:		True+    Default:		False+ -- Concurrency is used to implement Pondering, & parallelism is used when searching through archived games. flag threaded     Description:	Build for parallel runtime.@@ -98,6 +105,7 @@     Default:		True  -- Whether to use unboxed arrays where possible.+-- CAVEAT: incompatble with the flag 'precision'. flag unboxedarrays     Description:	Use unboxed arrays.     Manual:		True@@ -109,12 +117,60 @@     Description:	Link with package "unix" when available.     Default:		True -Library+common commonStanza     Default-language:	Haskell2010-    GHC-options:	-O2 -Wall -fno-warn-tabs -fno-warn-unused-top-binds -Wno-all-missed-specialisations++    Build-depends:+        base		== 4.*,+        containers	^>= 0.6.2,+        data-default	^>= 0.7.1,+        filepath++    GHC-options:	-Wall -Wredundant-constraints -fno-warn-tabs++common exeStanza+    Hs-source-dirs:	src-exe+    GHC-options:	-O2+    Autogen-modules:	Paths_bishbosh+    Other-modules:	Paths_bishbosh+    Build-depends:+        bishbosh,+        hxt	^>= 9.3.1++    if impl(ghc >= 7.0) && flag(llvm)+        GHC-options:	-fllvm++common profStanza+    if impl(ghc >= 7.4.1)+        GHC-prof-options:	-fprof-auto -fprof-cafs++        if flag(threaded)+            GHC-prof-options:	-fno-prof-count-entries+    else+        GHC-prof-options:	-auto-all -caf-all++common testStanza+    Hs-source-dirs:	src-test+    Build-depends:+        array		^>= 0.5.1.1,+        bishbosh,+        mtl		^>= 2.2.2,+        random,+        toolshed	^>= 0.18.0++    if flag(polyparse)+        Build-depends:	polyparse ^>= 1.13+        CPP-Options:	-DUSE_POLYPARSE='L'+    else+        Build-depends:	parsec ^>= 3.1.14.0++Library+    Import:		commonStanza, profStanza+    GHC-options:	-O2 -fno-warn-unused-top-binds -Wno-all-missed-specialisations     Hs-source-dirs:	src-lib      Exposed-modules:+        BishBosh.Attribute.ANSIColourCode         BishBosh.Attribute.CaptureMoveSortAlgorithm         BishBosh.Attribute.ColourScheme         BishBosh.Attribute.Direction@@ -127,6 +183,7 @@         BishBosh.Cartesian.Coordinates         BishBosh.Cartesian.Ordinate         BishBosh.Cartesian.Vector+        BishBosh.Component.Accountant         BishBosh.Component.CastlingMove         BishBosh.Component.EitherQualifiedMove         BishBosh.Component.Move@@ -143,7 +200,6 @@         BishBosh.ContextualNotation.StandardAlgebraic         BishBosh.Data.Bool         BishBosh.Data.Either-        BishBosh.Data.Enum         BishBosh.Data.Exception         BishBosh.Data.Foldable         BishBosh.Data.Integral@@ -178,8 +234,10 @@         BishBosh.Model.GameTree         BishBosh.Model.MoveFrequency         BishBosh.Model.PositionHashTree+        BishBosh.Notation.Figurine         BishBosh.Notation.ICCFNumeric         BishBosh.Notation.MoveNotation+        BishBosh.Notation.Notation         BishBosh.Notation.PureCoordinate         BishBosh.Notation.Smith         BishBosh.Property.Arboreal@@ -214,12 +272,14 @@         BishBosh.State.MaybePieceByCoordinates         BishBosh.State.Position         BishBosh.StateProperty.Censor+        BishBosh.StateProperty.Hashable         BishBosh.StateProperty.Mutator         BishBosh.StateProperty.Seeker         BishBosh.State.TurnsByLogicalColour         BishBosh.Text.AutoComplete         BishBosh.Text.Case         BishBosh.Text.Encoding+        BishBosh.Text.ShowColouredPrefix         BishBosh.Text.ShowList         BishBosh.Text.ShowPrefix         BishBosh.Time.GameClock@@ -234,168 +294,110 @@         BishBosh.UI.SetObject      Build-depends:-        array >= 0.5.1.1,-        base >= 4.9 && < 5.0,-        containers,-        data-default,-        deepseq >= 1.4.1,-        extra,-        factory >= 0.3.1,-        filepath,-        hxt,-        mtl,-        process >= 1.6.4,+        array		^>= 0.5.1.1,+        deepseq		^>= 1.4.1,+        extra		^>= 1.7.4,+        factory		^>= 0.3.1,+        hxt		^>= 9.3.1,+        mtl		^>= 2.2.2,+        process		>= 1.6.4,         random,         time,-        toolshed >= 0.18+        toolshed	^>= 0.18.0 -    if impl(ghc >= 7.0)-        if flag(llvm)-            GHC-options:	-fllvm+    if impl(ghc >= 7.0) && flag(llvm)+        GHC-options:	-fllvm -        if impl(ghc >= 7.4.1)-            GHC-prof-options:	-fprof-auto -fprof-cafs+    if flag(precision)+        CPP-Options:	-DUSE_PRECISION+    else+        if flag(narrownumbers)+            CPP-Options:	-DUSE_NARROW_NUMBERS -            if flag(threaded)-                GHC-prof-options:	-fno-prof-count-entries+        if flag(unboxedarrays)+            CPP-Options:	-DUSE_UNBOXED_ARRAYS -            if impl(ghc >= 8.0)-                GHC-options:	-Wredundant-constraints-        else-            GHC-prof-options:	-auto-all -caf-all+    if flag(newtypewrappers)+        CPP-Options:		-DUSE_NEWTYPE_WRAPPERS      if flag(polyparse)-        Build-depends:		polyparse-        CPP-Options:		-DUSE_POLYPARSE=2+        Build-depends:		polyparse ^>= 1.13+        CPP-Options:		-DUSE_POLYPARSE='L'         Exposed-modules:	BishBosh.Text.Poly     else-        Build-depends:		parsec--    if flag(narrownumbers)-        CPP-Options:		-DUSE_NARROW_NUMBERS--    if flag(newtypewrappers)-        CPP-Options:		-DUSE_NEWTYPE_WRAPPERS+        Build-depends:		parsec ^>= 3.1.14.0      if flag(threaded)         Build-depends:		parallel >= 3.0         CPP-Options:		-DUSE_PARALLEL -    if flag(unboxedarrays)-        CPP-Options:		-DUSE_UNBOXED_ARRAYS- Executable bishbosh-    Default-language:	Haskell2010-    GHC-options:	-O2 -Wall -fno-warn-tabs-    Hs-source-dirs:	src-exe-    Main-is:		Main.hs-    Autogen-modules:	Paths_bishbosh+    Import:	commonStanza, exeStanza, profStanza+    Main-is:	Main.hs      Other-modules:         BishBosh.Concurrent.Pondering         BishBosh.Play         BishBosh.State.ApplicationTerminationReason         BishBosh.State.PlayState-        BishBosh.Text.ShowColouredPrefix         BishBosh.UI.CECP         BishBosh.UI.Raw-        Paths_bishbosh      if flag(unix)         Other-modules:	BishBosh.Concurrent.SignalHandlers      Build-depends:-        array >= 0.5.1.1,-        base >= 4.9 && < 5.0,-        bishbosh,-        containers,-        data-default,-        deepseq >= 1.4.1,+        array		^>= 0.5.1.1,+        deepseq		^>= 1.4.1,         directory,-        extra,-        factory >= 0.3.1,-        filepath,-        hxt,-        mtl,+        extra		^>= 1.7.4,+        factory		^>= 0.3.1,+        mtl		^>= 2.2.2,         random,-        toolshed >= 0.18+        toolshed	^>= 0.18.0      if impl(ghc >= 7.0)-        if flag(llvm)-            GHC-options:	-fllvm-         if flag(threaded)             GHC-options:	-rtsopts "-with-rtsopts=-N -H100M"          if impl(ghc >= 7.4.1)-            GHC-prof-options:	-fprof-auto -fprof-cafs -rtsopts -with-rtsopts=-H100M--            if flag(threaded)-                GHC-prof-options:	-fno-prof-count-entries--            if impl(ghc >= 8.0)-                GHC-options:	-Wredundant-constraints-        else-            GHC-prof-options:	-auto-all -caf-all+            GHC-prof-options:	-rtsopts -with-rtsopts=-H100M      if flag(hxtrelaxng)-        Build-depends:	hxt-relaxng+        Build-depends:	hxt-relaxng ^>= 9.1.5         CPP-Options:	-DUSE_HXTRELAXNG -    if flag(narrownumbers)-        CPP-Options:	-DUSE_NARROW_NUMBERS-     if flag(threaded)-        CPP-Options:	-DUSE_PARALLEL         GHC-options:	-threaded -    if flag(unboxedarrays)+    if flag(unboxedarrays) && !flag(precision)         CPP-Options:	-DUSE_UNBOXED_ARRAYS  -- N.B.: The Haskell package 'unix' may be available on MS-Windows, but building it will probably be laborious.     if flag(unix)         Other-modules:	BishBosh.Concurrent.SignalHandlers-        Build-depends:	unix+        Build-depends:	unix ^>= 2.7.2+         CPP-Options:	-DUSE_UNIX  -- This application coordinates a duel between two independently configured instances of 'bishbosh'. Executable duel-    Default-language:	Haskell2010-    GHC-options:	-O2 -Wall -fno-warn-tabs-    Hs-source-dirs:	src-exe-    Main-is:		Duel.hs-    Autogen-modules:	Paths_bishbosh+    Import:	commonStanza, exeStanza+    Main-is:	Duel.hs      Other-modules:         Duel.Data.Options         Duel.IO.Logger         Duel.Process.Handles         Duel.Process.Intermediary-        Paths_bishbosh -    Build-depends:-        base >= 4.9 && < 5.0,-        bishbosh,-        containers,-        data-default,-        filepath,-        hxt,-        process >= 1.6.4+    Build-depends:	process >= 1.6.4      CPP-Options:	-DMOVE_NOTATION='S' -    if impl(ghc >= 7.0)-        if flag(llvm)-            GHC-options:	-fllvm--        if impl(ghc >= 8.0)-            GHC-options:	-Wredundant-constraints- -- Static unit-tests of the library. Test-Suite hunit-tests-    Default-language:	Haskell2010-    GHC-options:	-Wall -fno-warn-tabs-    Hs-source-dirs:	src-test+    Import:		commonStanza, testStanza     Main-is:		HUnit.hs     Type:		exitcode-stdio-1.0     Autogen-modules:	Paths_bishbosh@@ -426,34 +428,16 @@         Paths_bishbosh      Build-depends:-        array >= 0.5.1.1,-        base >= 4.9 && < 5.0,-        bishbosh,-        containers,-        data-default,-        filepath,         HUnit,-        hxt,-        mtl,-        random,-        toolshed >= 0.18--    if impl(ghc >= 8.0)-        GHC-options:	-Wredundant-constraints+        hxt	^>= 9.3.1 -    if flag(polyparse)-        Build-depends:	polyparse-        CPP-Options:	-DUSE_POLYPARSE=2-    else-        Build-depends:	parsec+--    CPP-Options:	-DUSE_BRATKO_KOPEC  -- Random unit-tests of the library. Test-Suite quickcheck-tests-    Default-language:	Haskell2010-    GHC-options:	-Wall -fno-warn-tabs-    Hs-source-dirs:	src-test-    Main-is:		QuickCheck.hs-    Type:		exitcode-stdio-1.0+    Import:	commonStanza, testStanza+    Main-is:	QuickCheck.hs+    Type:	exitcode-stdio-1.0      Other-modules:         BishBosh.Test.QuickCheck.Attribute.CaptureMoveSortAlgorithm@@ -495,6 +479,7 @@         BishBosh.Test.QuickCheck.Model.Game         BishBosh.Test.QuickCheck.Model.GameTree         BishBosh.Test.QuickCheck.Model.MoveFrequency+        BishBosh.Test.QuickCheck.Notation.Figurine         BishBosh.Test.QuickCheck.Notation.ICCFNumeric         BishBosh.Test.QuickCheck.Notation.MoveNotation         BishBosh.Test.QuickCheck.Notation.PureCoordinate@@ -510,38 +495,31 @@         BishBosh.Test.QuickCheck.State.InstancesByPosition         BishBosh.Test.QuickCheck.State.Position         BishBosh.Test.QuickCheck.StateProperty.Censor+        BishBosh.Test.QuickCheck.StateProperty.Hashable+        BishBosh.Test.QuickCheck.StateProperty.Seeker         BishBosh.Test.QuickCheck.State.TurnsByLogicalColour         BishBosh.Test.QuickCheck.Text.Encoding         BishBosh.Test.QuickCheck.Time.StopWatch+        BishBosh.Test.QuickCheck.Type.Count+        BishBosh.Test.QuickCheck.Type.Length         BishBosh.Test.QuickCheck.UI.Command         BishBosh.Test.QuickCheck.UI.PrintObject         BishBosh.Test.QuickCheck.UI.ReportObject         BishBosh.Test.QuickCheck.UI.SetObject      Build-depends:-        array >= 0.5.1.1,-        base >= 4.9 && < 5.0,-        bishbosh,-        containers,-        data-default,-        deepseq >= 1.4.1,-        extra,-        filepath,-        mtl,-        QuickCheck >= 2.8.2,-        random,-        toolshed >= 0.18+        deepseq		^>= 1.4.1,+        extra		^>= 1.7.4,+        QuickCheck	^>= 2.13.2 -    if impl(ghc >= 8.0)-        GHC-options:	-Wredundant-constraints+    if flag(newtypewrappers)+        CPP-Options:	-DUSE_NEWTYPE_WRAPPERS -    if flag(polyparse)-        Build-depends:	polyparse-        CPP-Options:	-DUSE_POLYPARSE=2-    else-        Build-depends:	parsec+    if flag(precision)+        CPP-Options:	-DUSE_PRECISION+    elif flag(narrownumbers)+        CPP-Options:	-DUSE_NARROW_NUMBERS      if flag(threaded)-        CPP-Options:	-DUSE_PARALLEL         GHC-options:	-threaded 

@@ -24,7 +24,7 @@  Summary:	BishBosh is a chess-game. Name:		bishbosh-Version:	0.1.1.0+Version:	0.1.2.0 Release:	1 License:	GPLv3 # From '/usr/share/doc/packages/rpm/GROUPS'.

@@ -90,17 +90,17 @@ ## 0.1.1.0 ### New Modules: ----------------------------------------------------------New Module					| Purpose-------------------------------------------------| --------**BishBosh.Time.StopWatch**			| Replaces module **BishBosh.Data.Time** to encapsulate interaction with module **Data.Time.Clock**.-**BishBosh.Time.GameClock**			| Contains two **BishBosh.Time.StopWatch**es to enable module **Duel.Process.Intermediary** to measure the time used by each player.-**BishBosh.Property.Switchable**		| Exports a type-class, which both **BishBosh.Time.StopWatch** & **BishBosh.Time.GameClock** implement, to expose their functionality.-**BishBosh.Property.SelfValidating**		| Exports a type-class, which both **BishBosh.Time.GameClock** & **Duel.Data.Options** implement, to validate themselves.-**BishBosh.Type.Countable**			| Defines newtypes to enhance type-safety, replacing type-synonyms for **Int**. There is a performance-degradation, so this enhancement can be disabled using a new cabal-flag.-**BishBosh.Type.Crypto**			| Self-documentation.-**BishBosh.Type.Length**			| Replaced the polymorphic type-parameters **row** & **column** with newtypes to enhance type-safety.-**BishBosh.Type.Mass**				| Self-documentation.-**BishBosh.Metric.RankValue**			| Replaced the polymorphic type-parameter **rankValue**, with a newtype & a smart-constructor to guard permissible bounds.+New Module				| Purpose+----------------------------------------| -------+**BishBosh.Time.StopWatch**		| Replaces module **BishBosh.Data.Time** to encapsulate interaction with module **Data.Time.Clock**.+**BishBosh.Time.GameClock**		| Contains two **BishBosh.Time.StopWatch**es to enable module **Duel.Process.Intermediary** to measure the time used by each player.+**BishBosh.Property.Switchable**	| Exports a type-class, which both **BishBosh.Time.StopWatch** & **BishBosh.Time.GameClock** implement, to expose their functionality.+**BishBosh.Property.SelfValidating**	| Exports a type-class, which both **BishBosh.Time.GameClock** & **Duel.Data.Options** implement, to validate themselves.+**BishBosh.Type.Countable**		| Defines newtypes to enhance type-safety, replacing type-synonyms for **Int**. There is a performance-degradation, so this enhancement can be disabled using a new cabal-flag.+**BishBosh.Type.Crypto**		| Self-documentation.+**BishBosh.Type.Length**		| Replaced the polymorphic type-parameters **row** & **column** with newtypes to enhance type-safety.+**BishBosh.Type.Mass**			| Self-documentation.+**BishBosh.Metric.RankValue**		| Replaced the polymorphic type-parameter **rankValue**, with a newtype & a smart-constructor to guard permissible bounds.  ### Duel: * Added command-line option **--verifyConfiguration**, to request that the mutual compatibility of the two configuration-files be verified before forwarding each to a forked instance of **bishbosh**.@@ -115,4 +115,34 @@ * Moved **BishBosh.Attribute.RankValues** to **BishBosh.Input**. * Checked that (with the possible exception of the King) the Queen is configured as the most valuable rank. * Avoided repeated calls from module **BishBosh.Evaluation.Fitness** to function **IBishBosh.nput.RankValues.calculateMaximumTotalValue** by adding the record-field **BishBosh.Input.EvaluationOptions.getMaximumTotalRankValue**.++## 0.1.2.0+* Features:+	+ Added a Boolean configuration-option **BishBosh.Input.NativeUIOptions.getDepictFigurine** to specify whether the native UI should depict pieces using Unicode figurines rather than merely ASCII letters.+	+ **duel** now accumulates the frequency-distribution of games played in order to detect duplicates & warn when there's insufficient randomness.+	+ Added the runtime ability to set the position using *Extended Position Description*.+* Efficiency:+	+ Reimplemented function **BishBosh.Cartesian.Abscissa.getAdjacents** to promote memoisation.+	+ Made **BishBosh.Cartesian.Coordinates** & **BishBosh.Attribute.Direction** strict.+	+ Changed to use **Double** rather than **Rational** to perform the calculations defined by **BishBosh.Evaluation.Fitness**, before conversion to **BishBosh.Metric.CriterionValue.CriterionValue**.+	+ Added a Boolean switch **preferVictories** to **standardOpeningOptions** to govern whether from all matching positions extracted from the PGN-database, to prefer moves which result in a greater probability of victory, for the player who has the next move. Turning this off reduces the evaluation required of the PGN-parser; & there's no down-side if the PGN-database is known not to actually record any victories.+	+ Improved **BishBosh.ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMovesForPosition**, by independently comparing the pieces of each player, between the target game & a node of the tree, allowing earlier termination of the search.+* Bug-fixes:+	+ Avoided potential divide-by-zero @ **BishBosh.Input.CriteriaWeights.getWeightOfMaterial** / **BishBosh.Input.RankValues.calculateMaximumTotalValue** @.+	+ Guarded against starting from a persisted, but terminated, game.+	+ Added guards to function **BishBosh.Component.Piece.promote**.+	+ Amended **BishBosh.Evaluation.Fitness.measurePieceSquareValueIncrementally** to forward Castling moves to **measurePieceSquareValue**.+	+ Polymorphism:+		* Replaced the polymorphic type **distance** in **BishBosh.Component.Vector**, with two concrete types **BishBosh.Type.Length.[XY]**. Removed the type **BishBosh.Type.Length.Distance**.+		* Replaced the polymorphic type-parameters **x** & **y** with newtypes to:+			+ eliminate the fragile **RULE** pragmas required to switch to memoised function-implementations for specific type-parameters,+			+ eliminate chains of **SPECIALISE** pragmas down the call-stack to hot-spots.+			+ allow external calls from [**Text.ParserCombinators.Poly.Lazy.runParser**, **Text.ParserCombinators.Parsec.parse**], to access specialised implementations (see previous items),+			+ permit unification of the similar type-classes **BishBosh.Component.Zobrist.Hashable[12]D**, & to avoid the requirement for the **MultiParameterTypeClasses** pragma.+* Structural:+	+ Moved the type-class from module **BishBosh.Component.Zobrist** into a new module **BishBosh.StateProperty.Hashable**.+	+ Replaced non-specific type @ (Int, Int) @ coordinates in **BishBosh.Notation.{ICCFNumeric, PureCoordinate, Smith}** with @ (**BishBosh.Type.Length.X**, **BishBosh.Type.Length.Y**) @, & moved common code into a new module **BishBosh.Notation.Notation**.+	+ Added type **BishBosh.Type.Count.NCoordinates** for use by function **BishBosh.Cartesian.Coordinates.nSquares**.+	+ Added a method **BishBosh.StateProperty.Seeker.countPawnsByFileByLogicalColour** including a default implementation, & relocated the implementation from module **BishBosh.State.CoordinatesByRankByLogicalColour**.+	+ Added a type-class **BishBosh.Component.Account.Accountant**, with a single method used to sum piece-square values; thus permiting a common interface between the implementations in **BishBosh.State.CoordinatesByRankByLogicalColour** & **BishBosh.State.MaybePieceByCoordinates**. 

@@ -26,8 +26,9 @@ 		&criteriaWeights; 		&pieceSquareTables_symmetric; 	</evaluationOptions>-	<searchOptions sortOnStandardOpeningMoveFrequency="True" captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" usePondering="True">+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="5"/> 		</searchDepthByLogicalColour>

@@ -26,8 +26,9 @@ 		&criteriaWeights; 		&pieceSquareTables_symmetric; 	</evaluationOptions>-	<searchOptions sortOnStandardOpeningMoveFrequency="True" captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" usePondering="True">+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 		</searchDepthByLogicalColour>

@@ -0,0 +1,45 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE options SYSTEM "../bishbosh.dtd">	<!-- CAVEAT: amend after relocating this file ! -->+<!--+	AUTHOR: Dr. Alistair Ward++	Copyright (C) 2021 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/>.+-->+<options>+	<evaluationOptions>+		&rankValues_Kaufman;+		&criteriaWeights;+		&pieceSquareTables_symmetric;+	</evaluationOptions>+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True">+		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings -->+		<searchDepthByLogicalColour>+			<byLogicalColour logicalColour="Black" searchDepth="4"/>+		</searchDepthByLogicalColour>+	</searchOptions>+	<ioOptions maximumPGNNames="8">+		&pgnOptions_SCID;+		<uiOptions>+			<nativeUIOptions depictFigurine="True">+				<colourScheme darkPieceColour="Black" darkSquareColour="Blue" lightPieceColour="White" lightSquareColour="Yellow"/>+			</nativeUIOptions>+		</uiOptions>+	</ioOptions>+</options>+

@@ -26,8 +26,9 @@ 		&criteriaWeights; 		&pieceSquareTables_symmetric; 	</evaluationOptions>-	<searchOptions sortOnStandardOpeningMoveFrequency="True" captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3">+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True"> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 			<byLogicalColour logicalColour="White" searchDepth="4"/>

@@ -31,16 +31,17 @@ 		<criteriaWeights material="1" mobility="0" pieceSquareValue="0.1" castlingPotential="0" defence="0" doubledPawns="0" isolatedPawns="0" passedPawns="0"/>	<!-- N.B. only those criteria under test need be non-zero --> 		&pieceSquareTables_Rofchade; 	</evaluationOptions>-	<searchOptions sortOnStandardOpeningMoveFrequency="True" captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" usePondering="False">	<!-- CAVEAT: pondering uses time more productively used by the other instance -->+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="False">	<!-- CAVEAT: pondering uses time more productively used by the other instance --> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- maximise randomness --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="3"/> 		</searchDepthByLogicalColour> 	</searchOptions> 	<ioOptions>-		&pgnOptions_SCID;	<!-- CAVEAT: specification of a PGN-database is required for non-determininstic behaviour -->+		&pgnOptions_SCID; &pgnOptions_FICS;	<!-- CAVEAT: specification of a PGN-database is required for non-deterministic behaviour --> 		<persistence filePath="/dev/null" automatic="False"/>	<!-- CAVEAT: otherwise the game may already have started -->-		<uiOptions moveNotation="Smith">	<!-- CAVEAT: coordinate with the opponent defined in 'bishbosh_duel_white.txt' & 'bishbosh.cabal' -->+		<uiOptions moveNotation="Smith">	<!-- CAVEAT: coordinate with the opponent defined in 'bishbosh_duel_white.txt' & the compilation-flag in 'bishbosh.cabal' --> 			<nativeUIOptions/> 		</uiOptions> 	</ioOptions>

@@ -31,16 +31,17 @@ 		<criteriaWeights material="1" mobility="0" pieceSquareValue="0.1" castlingPotential="0" defence="0" doubledPawns="0" isolatedPawns="0" passedPawns="0"/>	<!-- N.B. only those criteria under test need be non-zero --> 		&pieceSquareTables_symmetric; 	</evaluationOptions>-	<searchOptions sortOnStandardOpeningMoveFrequency="True" captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" usePondering="False">	<!-- CAVEAT: pondering uses time more productively used by the other instance -->+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="False">	<!-- CAVEAT: pondering uses time more productively used by the other instance --> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- maximise randomness --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="White" searchDepth="3"/> 		</searchDepthByLogicalColour> 	</searchOptions> 	<ioOptions>-		&pgnOptions_SCID;	<!-- CAVEAT: specification of a PGN-database is required for non-determininstic behaviour -->+		&pgnOptions_SCID; &pgnOptions_FICS;	<!-- CAVEAT: specification of a PGN-database is required for non-deterministic behaviour --> 		<persistence filePath="/dev/null" automatic="False"/>	<!-- CAVEAT: otherwise the game may already have started -->-		<uiOptions moveNotation="Smith">	<!-- CAVEAT: coordinate with the opponent defined in 'bishbosh_duel_black.txt' & 'bishbosh.cabal' -->+		<uiOptions moveNotation="Smith">	<!-- CAVEAT: coordinate with the opponent defined in 'bishbosh_duel_black.txt' & the compilation-flag in 'bishbosh.cabal' --> 			<nativeUIOptions/> 		</uiOptions> 	</ioOptions>

@@ -26,8 +26,9 @@ 		<criteriaWeights material="1" mobility="0.01" pieceSquareValue="0.01" castlingPotential="0.01" defence="0.0001" doubledPawns="0.0001" isolatedPawns="0.0001" passedPawns="0.0001"/> 		&pieceSquareTables_symmetric; 	</evaluationOptions>-	<searchOptions sortOnStandardOpeningMoveFrequency="True" captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3">+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True"> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="Black" searchDepth="4"/> 			<byLogicalColour logicalColour="White" searchDepth="4"/>

@@ -26,8 +26,9 @@ 		&criteriaWeights; 		&pieceSquareTables_symmetric; 	</evaluationOptions>-	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" usePondering="True">+	<searchOptions captureMoveSortAlgorithm="MVVLVA" retireKillerMovesAfter="3" sortOnStandardOpeningMoveFrequency="True" usePondering="True"> 		&transpositions;+		<standardOpeningOptions preferVictories="False"/>	<!-- the SCID PGN-database only contains standard-openings --> 		<searchDepthByLogicalColour> 			<byLogicalColour logicalColour="White" searchDepth="4"/> 		</searchDepthByLogicalColour>

@@ -80,6 +80,7 @@ 				tryToMatchMoves			(False | True)	#IMPLIED 				tryToMatchViaJoiningMove	(False | True)	#IMPLIED 				tryToMatchColourFlippedPosition	(False | True)	#IMPLIED+				preferVictories			(False | True)	#IMPLIED 			> 		<!ELEMENT searchDepthByLogicalColour (byLogicalColour)*> 			<!ELEMENT byLogicalColour EMPTY>@@ -127,6 +128,9 @@ 				verbosity	(Silent | Normal | Verbose | Deafening)	#IMPLIED 			> 			<!ELEMENT nativeUIOptions ((boardMagnification)?, (colourScheme)?)>+				<!ATTLIST nativeUIOptions+					depictFigurine	(False | True)	#IMPLIED+				> 				<!ELEMENT boardMagnification EMPTY> 					<!ATTLIST boardMagnification 						nRows		CDATA	#REQUIRED

@@ -104,6 +104,10 @@ 								<attribute name="tryToMatchColourFlippedPosition"> 									<ref name="Boolean"/> 								</attribute>+							</optional><optional>+								<attribute name="preferVictories">+									<ref name="Boolean"/>+								</attribute> 							</optional> 						</element>	<!-- standardOpeningOptions --> 					</optional>@@ -220,6 +224,10 @@ 								<choice> 									<element name="nativeUIOptions"> 										<optional>+											<attribute name="depictFigurine">+												<ref name="Boolean"/>+											</attribute>+										</optional><optional> 											<element name="boardMagnification"> 												<attribute name="nRows"> 													<data type="positiveInteger"/>

@@ -13,7 +13,7 @@ # You should have received a copy of the GNU General Public License # along with BishBosh.  If not, see <http://www.gnu.org/licenses/>. -.PHONY: cabalCheck duel findOmissions graphmod haddock hlint prof randomTest sdist test xboard+.PHONY: cabalCheck duel findOmissions graphmod haddock hlint prof profN2 randomTest sdist test xboard  PACKAGE_NAME	= bishbosh SHELL		= /bin/bash@@ -29,45 +29,50 @@  # Groom sourcecode. hlint: $(BIN_DIR)/hlint-	@$@ -j --no-exit-code\+	@$@ -j	--no-exit-code\+		--cpp-define 'USE_NEWTYPE_WRAPPERS'\ 		--cpp-define 'USE_PARALLEL'\-		--cpp-define 'USE_POLYPARSE=1'\+		--cpp-define 'USE_POLYPARSE=L'\ 		--cpp-define 'USE_UNBOXED_ARRAYS'\-		--cpp-define 'USE_NEWTYPE_WRAPPERS'\ 		--ignore 'Use tuple-section'\ 		src-lib/ +RTS -N -RTS-	@$@ -j --no-exit-code\+	@$@ -j	--no-exit-code\+		--cpp-define 'MOVE_NOTATION=S'\ 		--cpp-define 'USE_HXTRELAXNG'\-		--cpp-define 'USE_PARALLEL'\ 		--cpp-define 'USE_UNBOXED_ARRAYS'\ 		--cpp-define 'USE_UNIX'\-		--cpp-define 'MOVE_NOTATION=S'\ 		--ignore 'Reduce duplication'\ 		src-exe/ +RTS -N -RTS-	@$@ -j 	--cpp-define 'USE_PARALLEL'\-		--cpp-define 'USE_POLYPARSE=1'\-		--cpp-define 'USE_SEARCH'\+	@$@ -j	--cpp-define 'USE_NEWTYPE_WRAPPERS'\+		--cpp-define 'USE_POLYPARSE=L'\+		--cpp-define 'USE_BRATKO_KOPEC'\ 		--ignore 'Use tuple-section'\ 		src-test/ +RTS -N -RTS  # Serially compile with various CPP-flags & run the test-suites. test:-	@for FLAG in -polyparse newtypewrappers -hxtrelaxng narrownumbers unboxedarrays -threaded; do\+	@for FLAG in -polyparse newtypewrappers narrownumbers unboxedarrays -hxtrelaxng -threaded precision; do\ 		echo $${FLAG};\ 		stack '$@' --flag="$(PACKAGE_NAME):$${FLAG}" $(GHC_OPTIONS) || break;\ 	done  # Compile with random CPP-flags & run the test-suites. randomTest:-	@FLAGS=$$(shuf --echo -- hxtrelaxng -hxtrelaxng narrownumbers -narrownumbers newtypewrappers -newtypewrappers polyparse -polyparse threaded -threaded unboxedarrays -unboxedarrays | head --lines=3 | sed -e 's/\(.*\)/--flag=$(PACKAGE_NAME):\1/');\-	echo $$FLAGS;\+	FLAGS=$$(shuf --echo -- hxtrelaxng narrownumbers newtypewrappers polyparse precision threaded unboxedarrays | head --lines=3 | sed -e '1s/^/-/' -e 's/\(.*\)/--flag=$(PACKAGE_NAME):\1/');\+	echo $${FLAGS};\ 	stack test $${FLAGS} $(GHC_OPTIONS) -# Profile.+# Profile a single-threaded build, to access entry-counts. prof:-	@stack install --library-profiling --executable-profiling $(GHC_OPTIONS)-	@$(PACKAGE_NAME) -i 'config/Raw/$(PACKAGE_NAME)_$@.xml' +RTS -p -N2 -RTS+	@stack install --profile --flag='bishbosh:-threaded' $(GHC_OPTIONS);+	sleep 16;	# Let the test-machine reach a quiescent state.+	@$(PACKAGE_NAME) -i 'config/Raw/$(PACKAGE_NAME)_$@.xml' +RTS -p -RTS +# Profile.+profN2:+	@stack install --profile $(GHC_OPTIONS);+	@$(PACKAGE_NAME) -i 'config/Raw/$(PACKAGE_NAME)_prof.xml' +RTS -p -N2 -RTS+ # Install this product. $(BIN_DIR)/$(PACKAGE_NAME) $(BIN_DIR)/duel: 	@stack install $(GHC_OPTIONS)@@ -94,5 +99,5 @@  # Find source-files missing from the distribution. findOmissions: sdist-	@diff <(find src-* -type f -name '*.hs' | sed 's!^\./!!' | sort) <(tar -ztf dist*/sdist/$(PACKAGE_NAME)-*.tar.gz | grep '\.hs$$' | grep -v 'Setup.hs' | sed 's!^$(PACKAGE_NAME)-[0-9.]*/!!' | sort)+	@diff <(find src-* -type f -name '*.hs' | sed 's!^\./!!' | sort) <(tar -ztf `find dist* -mtime 0 -name '$(PACKAGE_NAME)-*.tar.gz' -print` | grep '\.hs$$' | grep -v 'Setup.hs' | sed 's!^$(PACKAGE_NAME)-[0-9.]*/!!' | sort) 

@@ -110,7 +110,7 @@ :restart		Start a new game. :rollBack	[Int]	Roll-back the optionally specified number of plies (half moves), defaulting to "\fB2\fR" when there's one manual player & "\fB1\fR" when both players are manual. :save		Save the current game-state in "\fB~/.bishbosh\fR"; this is automatic unless explicitly un-configured.-:set	\fBsearchDepth\fR \fIInt\fR	Mutate the value of "\fBsearchDepth\fR", (see "\fBsearchOptions\fR" in \fBsection-5\fR of the man-pages).+:set	object	Specify "\fBEPD\fR <String>" to define the position using \fBExtended Position Description\fR or "\fBsearchDepth\fR <Int>" to define the number of plies to search. :swap		Swap sides. If the moves of one side were automated, then this will cause automation of the moves of the other side. .TE .SS Hardware-requirements.

@@ -11,6 +11,11 @@ while measuring the total time taken by either side & collating the game-results to permit comparison of the fitness of their respective configurations. .PP This process facilitates optimisation of the complex configuration of \fBbishbosh\fR.+.PP+CAVEAT: the population of games resulting from this statistical experiment must be diverse, but this application's logic is largely deterministic (& both players are configured to use it).+In order to introduce some randomness, PGN-databases must be configured in which the application may search for positions matching the current game.+When more than one match for the current position is found, one of them is \fIrandomly\fR selected at the source of the next move.+If the specified PGN-databases fail to provide such move-options, deterministic play will result. .SH OPTIONS .TP \fB--verbosity=\fR(\fBSilent\fR|\fBNormal\fR|\fBVerbose\fR|\fBDeafening\fR), defaulting to "\fBNormal\fR".@@ -88,6 +93,9 @@ .SH AUTHOR Written by Dr. Alistair Ward. .SH BUGS+.PP+In the absence of any configured \fBpgnOptions\fR, the game is completely deterministic & will reproduce the previous result endlessly.+Even when PGN-databases have been configured, they may introduce insufficient randomness to produce a large population of unique games on which to perform statistical analysis. .SS "REPORTING BUGS" Report bugs to "\fBbishbosh@functionalley.com\fR". .SH COPYRIGHT

@@ -140,6 +140,7 @@ tryToMatchMoves	Bool	True	whether to attempt to exactly match the moves already made, with a standard opening; i.e. without matching transpositions. tryToMatchViaJoiningMove	Bool	True	whether to attempt to join the current position (irrespective of the means by which it was achieved) to a standard opening that's only one move away. tryToMatchColourFlippedPosition	Bool	True	whether to attempt to match a colour-flipped (<\fBhttps://www.chessprogramming.org/Color_Flipping\fR>) version of the current position with a standard opening.+preferVictories	Bool	True	whether from all matching positions extracted from the PGN-database, to prefer moves which result in a greater probability of victory, for the player who has the next move. .TE .IP \(bu \fBsearchDepth\fR \fIInt\fR, defaulting to "\fB4\fR" (minimum "\fB1\fR"): the number of plies (half moves) to search ahead, when selecting the next move.@@ -220,6 +221,9 @@ darkSquareColour	(\fBBlack\fR|\fBRed\fR|\fBGreen\fR|\fBBlue\fR|\fBMagenta\fR|\fBCyan\fR) lightSquareColour	(\fBRed\fR|\fBGreen\fR|\fBYellow\fR|\fBMagenta\fR|\fBCyan\fR|\fBWhite\fR) .TE+.IP \(bu+\fBdepictFigurine\fR: specifies whether to depict pieces as Unicode figurines, or merely ASCII letters.+This will require a terminal configured to render Unicode. .SH FILES .TS lb	lb

@@ -47,7 +47,10 @@ import qualified	BishBosh.Input.Options						as Input.Options import qualified	BishBosh.Input.SearchOptions					as Input.SearchOptions import qualified	BishBosh.Input.UIOptions					as Input.UIOptions+import qualified	BishBosh.Input.Verbosity					as Input.Verbosity+import qualified	BishBosh.Model.Game						as Model.Game import qualified	BishBosh.Model.GameTree						as Model.GameTree+import qualified	BishBosh.Model.MoveFrequency					as Model.MoveFrequency import qualified	BishBosh.Notation.MoveNotation					as Notation.MoveNotation import qualified	BishBosh.Property.Arboreal					as Property.Arboreal import qualified	BishBosh.Property.Empty						as Property.Empty@@ -55,13 +58,12 @@ import qualified	BishBosh.State.PlayState					as State.PlayState import qualified	BishBosh.Text.ShowColouredPrefix				as Text.ShowColouredPrefix import qualified	BishBosh.Type.Crypto						as Type.Crypto-import qualified	BishBosh.Type.Length						as Type.Length import qualified	BishBosh.Type.Mass						as Type.Mass import qualified	BishBosh.UI.CECP						as UI.CECP import qualified	BishBosh.UI.Raw							as UI.Raw import qualified	Control.DeepSeq import qualified	Control.Exception-import qualified	Data.Array.IArray+import qualified	Control.Monad import qualified	Data.Bits import qualified	Data.Default import qualified	Data.Maybe@@ -76,39 +78,32 @@  -- | Plays the game according to the specified configuration. play :: (-	Control.DeepSeq.NFData					pieceSquareValue,-	Control.DeepSeq.NFData					x,-	Control.DeepSeq.NFData					y,-	Data.Array.IArray.Ix					x,+	Control.DeepSeq.NFData		pieceSquareValue, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.FiniteBits					positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Ord							positionHash,-	Read							x,-	Read							y,-	Real							pieceSquareValue,-	Show							pieceSquareValue,-	Show							x,-	Show							y,-	System.Random.Random					positionHash,-	System.Random.RandomGen					randomGen+	Data.Bits.FiniteBits		positionHash,+	Fractional			pieceSquareValue,+	Ord				positionHash,+	Real				pieceSquareValue,+	Show				pieceSquareValue,+	System.Random.Random		positionHash,+	System.Random.RandomGen		randomGen  )-	=> randomGen-	-> Input.Options.Options pieceSquareValue x y-	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest x y	-- ^ Standard openings.-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+	=> Input.Verbosity.Verbosity+	-> randomGen+	-> Input.Options.Options pieceSquareValue+	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest	-- ^ Standard openings.+	-> IO (State.PlayState.PlayState pieceSquareValue positionHash) {-# SPECIALISE play 	:: System.Random.RandomGen randomGen-	=> randomGen-	-> Input.Options.Options Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y-	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest Type.Length.X Type.Length.Y-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y)+	=> Input.Verbosity.Verbosity+	-> randomGen+	-> Input.Options.Options Type.Mass.PieceSquareValue+	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest+	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)  #-}-play randomGen options qualifiedMoveForest	= Data.Maybe.maybe (+play verbosity randomGen options qualifiedMoveForest	= Data.Maybe.maybe ( 	return {-to IO-monad-} Data.Default.def {-game-}  ) ( 	\(filePath, _) -> if any (System.FilePath.equalFilePath filePath) [@@ -118,9 +113,16 @@ 		then return {-to IO-monad-} Data.Default.def {-game-} 		else Control.Exception.catch ( 			do-				s	<- readFile filePath+				game	<- read <$> readFile filePath -				return {-to IO-monad-} $! read s	-- Force evaluation, to trigger any exception thrown from within 'catch'.+				Data.Maybe.maybe (+					return {-to IO-monad-} $! game	-- Force evaluation, to trigger any exception thrown from within 'catch'.+				 ) (+					\terminationReason -> do+						Control.Monad.when (verbosity > minBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixWarning . showString "persisted game had terminated (" $ shows terminationReason "); restarting game."++						return {-to IO-monad-} Data.Default.def+				 ) $ Model.Game.getMaybeTerminationReason game 		) $ \e -> do 			System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixWarning . showString "'readFile' failed; " $ shows (e :: Control.Exception.SomeException) "." @@ -128,9 +130,18 @@  ) ( 	Input.IOOptions.getMaybePersistence ioOptions  ) >>= (-	(+	let+		sortOnStandardOpeningMoveFrequency	= Input.SearchOptions.getSortOnStandardOpeningMoveFrequency searchOptions++		moveFrequency+			| sortOnStandardOpeningMoveFrequency	= Model.GameTree.toMoveFrequency $ ContextualNotation.QualifiedMoveForest.toGameTree qualifiedMoveForest+			| otherwise				= Property.Empty.empty+	in ( 		\playState -> Data.Maybe.maybe (-			return {-to IO-monad-} playState+			do+				Control.Monad.when (sortOnStandardOpeningMoveFrequency && verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . shows (Model.MoveFrequency.countEntries moveFrequency) . showString " plies are recorded in the tree, of which " $ shows (Model.MoveFrequency.countDistinctEntries moveFrequency) " are distinct."++				return {-to IO-monad-} playState 		) ( 			\depth -> do 				System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "Move-tree:\n" $ (@@ -141,11 +152,7 @@  				return {-to IO-monad-} playState 		) $ Input.UIOptions.getMaybePrintMoveTree uiOptions-	) . State.PlayState.initialise options zobrist (-		if Input.SearchOptions.getSortOnStandardOpeningMoveFrequency searchOptions-			then Model.GameTree.toMoveFrequency $ ContextualNotation.QualifiedMoveForest.toGameTree qualifiedMoveForest-			else Property.Empty.empty {-MoveFrequency-}-	)+	) . State.PlayState.initialise options zobrist moveFrequency  ) >>= ( 	const UI.Raw.takeTurns ||| const UI.CECP.takeTurns $ Input.UIOptions.getEitherNativeUIOrCECPOptions uiOptions	-- Select a user-interface.  ) (

@@ -73,10 +73,8 @@ import qualified	BishBosh.State.ApplicationTerminationReason		as State.ApplicationTerminationReason import qualified	BishBosh.State.TurnsByLogicalColour			as State.TurnsByLogicalColour import qualified	BishBosh.Type.Crypto					as Type.Crypto-import qualified	BishBosh.Type.Length					as Type.Length import qualified	BishBosh.Type.Mass					as Type.Mass import qualified	Control.Exception-import qualified	Data.Array.IArray import qualified	Data.Bits import qualified	Data.Default import qualified	Data.List@@ -89,40 +87,35 @@ #endif  -- | The type threaded through the sequence of /game/s during play.-data PlayState pieceSquareValue positionHash x y	= MkPlayState {+data PlayState pieceSquareValue positionHash	= MkPlayState { 	getCriterionValues			:: [[Metric.CriterionValue.CriterionValue]],					-- ^ The /criterion-value/s accumulated during the game.-	getZobrist				:: Component.Zobrist.Zobrist x y positionHash,					-- ^ The constant hash-codes used construct position-hashes.-	getMoveFrequency			:: Model.GameTree.MoveFrequency x y,						-- ^ The constant frequency of moves extracted from file.-	getSearchState				:: Search.SearchState.SearchState x y positionHash,-	getOptions				:: Input.Options.Options pieceSquareValue x y,					-- ^ The constant options by which the game is configured.+	getZobrist				:: Component.Zobrist.Zobrist positionHash,					-- ^ The constant hash-codes used to construct position-hashes.+	getMoveFrequency			:: Model.GameTree.MoveFrequency,						-- ^ The constant frequency of moves extracted from file.+	getSearchState				:: Search.SearchState.SearchState positionHash,+	getOptions				:: Input.Options.Options pieceSquareValue,					-- ^ The constant options by which the game is configured. 	getMaybeApplicationTerminationReason	:: Maybe State.ApplicationTerminationReason.ApplicationTerminationReason	-- ^ Whether the game has terminated. }  -- | Constructor. initialise :: (-	Data.Array.IArray.Ix					x, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Real							pieceSquareValue,-	Show							x,-	Show							y+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Real				pieceSquareValue  )-	=> Input.Options.Options pieceSquareValue x y-	-> Component.Zobrist.Zobrist x y positionHash-	-> Model.GameTree.MoveFrequency x y-	-> Model.Game.Game x y-	-> PlayState pieceSquareValue positionHash x y+	=> Input.Options.Options pieceSquareValue+	-> Component.Zobrist.Zobrist positionHash+	-> Model.GameTree.MoveFrequency+	-> Model.Game.Game+	-> PlayState pieceSquareValue positionHash {-# SPECIALISE initialise-	:: Input.Options.Options Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y-	-> Component.Zobrist.Zobrist Type.Length.X Type.Length.Y Type.Crypto.PositionHash-	-> Model.GameTree.MoveFrequency Type.Length.X Type.Length.Y-	-> Model.Game.Game Type.Length.X Type.Length.Y-	-> PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y+	:: Input.Options.Options Type.Mass.PieceSquareValue+	-> Component.Zobrist.Zobrist Type.Crypto.PositionHash+	-> Model.GameTree.MoveFrequency+	-> Model.Game.Game+	-> PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash  #-} initialise options zobrist moveFrequency game	= MkPlayState { 	getCriterionValues			= [],@@ -136,32 +129,27 @@ }  -- | Accessor.-getGame :: PlayState pieceSquareValue positionHash x y -> Model.Game.Game x y+getGame :: PlayState pieceSquareValue positionHash -> Model.Game.Game getGame MkPlayState { getSearchState = searchState }	= Evaluation.QuantifiedGame.getGame . Evaluation.PositionHashQuantifiedGameTree.getRootQuantifiedGame $ Search.SearchState.getPositionHashQuantifiedGameTree searchState  -- | The type of a function used to transform a 'PlayState'.-type Transformation pieceSquareValue positionHash x y	= PlayState pieceSquareValue positionHash x y -> PlayState pieceSquareValue positionHash x y+type Transformation pieceSquareValue positionHash	= PlayState pieceSquareValue positionHash -> PlayState pieceSquareValue positionHash  -- | Mutator.-setPositionHashQuantifiedGameTree :: Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree x y positionHash -> Transformation pieceSquareValue positionHash x y+setPositionHashQuantifiedGameTree :: Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree positionHash -> Transformation pieceSquareValue positionHash setPositionHashQuantifiedGameTree positionHashQuantifiedGameTree playState@MkPlayState { getSearchState = searchState }	= playState { 	getSearchState	= searchState { Search.SearchState.getPositionHashQuantifiedGameTree = positionHashQuantifiedGameTree } }  -- | Reconstruct the /positionHashQuantifiedGameTree/ (in the /searchState/), with the apex set to the specified game. reconstructPositionHashQuantifiedGameTree :: (-	Data.Array.IArray.Ix					x, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Real							pieceSquareValue,-	Show							x,-	Show							y- ) => Model.Game.Game x y -> Transformation pieceSquareValue positionHash x y+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Real				pieceSquareValue+ ) => Model.Game.Game -> Transformation pieceSquareValue positionHash reconstructPositionHashQuantifiedGameTree game playState@MkPlayState { 	getZobrist		= zobrist, 	getMoveFrequency	= moveFrequency,@@ -174,18 +162,13 @@  -- | Reset to the initial state. resetPositionHashQuantifiedGameTree :: (-	Data.Array.IArray.Ix					x, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Real							pieceSquareValue,-	Show							x,-	Show							y- ) => Transformation pieceSquareValue positionHash x y+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Real				pieceSquareValue+ ) => Transformation pieceSquareValue positionHash resetPositionHashQuantifiedGameTree playState	= reconstructPositionHashQuantifiedGameTree Data.Default.def playState { 	getCriterionValues			= [], 	getMaybeApplicationTerminationReason	= Nothing@@ -194,15 +177,15 @@ -- | Mutator. updateWithAutomaticMove 	:: [Metric.CriterionValue.CriterionValue]-	-> Search.SearchState.SearchState x y positionHash-	-> Transformation pieceSquareValue positionHash x y+	-> Search.SearchState.SearchState positionHash+	-> Transformation pieceSquareValue positionHash updateWithAutomaticMove criterionValues searchState playState	= playState { 	getCriterionValues	= criterionValues : getCriterionValues playState, 	getSearchState		= searchState }  -- | Mutator.-updateWithManualMove :: (Eq x, Eq y) => Model.Game.Game x y -> Transformation pieceSquareValue positionHash x y+updateWithManualMove :: Model.Game.Game -> Transformation pieceSquareValue positionHash updateWithManualMove game playState@MkPlayState { getSearchState = searchState }	= setPositionHashQuantifiedGameTree ( 	Data.Maybe.fromMaybe ( 		Control.Exception.throw $ Data.Exception.mkIncompatibleData "BishBosh.State.PlayState.updateWithManualMove:\tEvaluation.PositionHashQuantifiedGameTree.reduce failed."@@ -222,7 +205,7 @@ 	Floating	standardDeviation, 	Fractional	mean  )-	=> PlayState pieceSquareValue positionHash x y+	=> PlayState pieceSquareValue positionHash 	-> [(mean, standardDeviation)] calculateCriterionValueStatistics MkPlayState { getCriterionValues = criterionValues }	= map ( 	(@@ -233,22 +216,15 @@  ) $ Data.List.transpose criterionValues  -- | Resignation by the player who currently holds the choice of move.-resign :: Transformation pieceSquareValue positionHash x y+resign :: Transformation pieceSquareValue positionHash resign playState@MkPlayState { getSearchState = searchState }	= setPositionHashQuantifiedGameTree ( 	Evaluation.PositionHashQuantifiedGameTree.resign $ Search.SearchState.getPositionHashQuantifiedGameTree searchState  ) playState  -- | Given a string from which either a /move/ can't be parsed or the one that can is illegal, returns the closest matches amongst the currently available /move/s.-suggestCorrections :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- )-	=> String	-- ^ Move-string.-	-> PlayState pieceSquareValue positionHash x y+suggestCorrections+	:: String	-- ^ Move-string.+	-> PlayState pieceSquareValue positionHash 	-> [String]	-- ^ Suggested corrections. suggestCorrections moveString playState@MkPlayState { getOptions = options } 	| Model.Game.isTerminated game	= []@@ -260,12 +236,12 @@  -- | Whether the game in the first /play-state/ has more plies than that in the second. hasMorePlies-	:: PlayState pieceSquareValue positionHash x y-	-> PlayState pieceSquareValue positionHash x y+	:: PlayState pieceSquareValue positionHash+	-> PlayState pieceSquareValue positionHash 	-> Bool hasMorePlies playState playState'	= Data.Ord.comparing (State.TurnsByLogicalColour.getNPlies . Model.Game.getTurnsByLogicalColour . getGame) playState playState' == GT  -- | Whether the user has requested application-termination, or the configured maximum number of turns has been reached.-hasApplicationTerminationBeenRequested :: PlayState pieceSquareValue positionHash x y -> Bool+hasApplicationTerminationBeenRequested :: PlayState pieceSquareValue positionHash -> Bool hasApplicationTerminationBeenRequested MkPlayState { getMaybeApplicationTerminationReason = maybeApplicationTerminationReason }	= Data.Maybe.isJust maybeApplicationTerminationReason 

@@ -1,52 +0,0 @@-{--	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@]	Define standard prefixes for log-messages.--}--module BishBosh.Text.ShowColouredPrefix(--- * Constants-	showsPrefixInfo,-	showsPrefixWarning,-	showsPrefixError- ) where--import qualified	BishBosh.Attribute.PhysicalColour	as Attribute.PhysicalColour-import qualified	BishBosh.Text.ShowPrefix		as Text.ShowPrefix---- | Show the prefix used to denote an information-message.-showsPrefixInfo :: ShowS-showsPrefixInfo	= Attribute.PhysicalColour.bracket (-	Attribute.PhysicalColour.selectGraphicsRendition False $ Attribute.PhysicalColour.mkFgColourCode Attribute.PhysicalColour.green- ) $ Text.ShowPrefix.showsPrefixInfo ""---- | Show the prefix used to denote a warning-message.-showsPrefixWarning :: ShowS-showsPrefixWarning	= Attribute.PhysicalColour.bracket (-	Attribute.PhysicalColour.selectGraphicsRendition True $ Attribute.PhysicalColour.mkFgColourCode Attribute.PhysicalColour.yellow- ) $ Text.ShowPrefix.showsPrefixWarning ""---- | Show the prefix used to denote an error-message.-showsPrefixError :: ShowS-showsPrefixError	= Attribute.PhysicalColour.bracket (-	Attribute.PhysicalColour.selectGraphicsRendition True $ Attribute.PhysicalColour.mkFgColourCode Attribute.PhysicalColour.red- ) $ Text.ShowPrefix.showsPrefixError ""-

@@ -85,7 +85,6 @@ import qualified	BishBosh.Time.StopWatch						as Time.StopWatch import qualified	BishBosh.Type.Count						as Type.Count import qualified	BishBosh.Type.Crypto						as Type.Crypto-import qualified	BishBosh.Type.Length						as Type.Length import qualified	BishBosh.Type.Mass						as Type.Mass import qualified	BishBosh.UI.Command						as UI.Command import qualified	BishBosh.UI.PrintObject						as UI.PrintObject@@ -96,12 +95,12 @@ import qualified	Control.Exception import qualified	Control.Monad import qualified	Control.Monad.Reader-import qualified	Data.Array.IArray import qualified	Data.Bits import qualified	Data.Default+import qualified	Data.Foldable import qualified	Data.List import qualified	Data.List.Extra-import qualified	Data.Map+import qualified	Data.Map.Strict							as Map import qualified	Data.Maybe import qualified	System.IO import qualified	System.Random@@ -170,7 +169,7 @@ showsThinking 	:: Property.ShowFloat.ShowFloat stoppedWatch 	=> Type.Count.NPlies		-- ^ Search-depth.-	-> Input.EvaluationOptions.EvaluationOptions pieceSquareValue x y+	-> Input.EvaluationOptions.EvaluationOptions pieceSquareValue 	-> Type.Mass.WeightedMean 	-> stoppedWatch 	-> Type.Count.NPositions	-- ^ Nodes searched.@@ -192,37 +191,30 @@  	* Since the user can also request roll-back to an earlier game before then requesting a new move, a new game is returned rather than just the requested move. -}-readMove :: forall pieceSquareValue positionHash randomGen x y. (-	Control.DeepSeq.NFData					pieceSquareValue,-	Control.DeepSeq.NFData					x,-	Control.DeepSeq.NFData					y,-	Data.Array.IArray.Ix					x,+readMove :: forall pieceSquareValue positionHash randomGen. (+	Control.DeepSeq.NFData		pieceSquareValue, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Ord							positionHash,-	Real							pieceSquareValue,-	Show							pieceSquareValue,-	Show							x,-	Show							y,-	System.Random.RandomGen					randomGen+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Ord				positionHash,+	Real				pieceSquareValue,+	Show				pieceSquareValue,+	System.Random.RandomGen		randomGen  )-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree x y positionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen 	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState pieceSquareValue positionHash x y-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+	-> State.PlayState.PlayState pieceSquareValue positionHash+	-> IO (State.PlayState.PlayState pieceSquareValue positionHash) {-# SPECIALISE readMove 	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash 	-> randomGen 	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y)+	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash+	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)  #-} readMove positionHashQualifiedMoveTree randomGen	= slave where 	slave runningWatch playState	= let@@ -230,7 +222,7 @@ 		(searchOptions, ioOptions)	= Input.Options.getSearchOptions &&& Input.Options.getIOOptions $ options  		(searchDepthByLogicalColour, tryToMatchSwitches)	= Input.SearchOptions.getSearchDepthByLogicalColour &&& Input.StandardOpeningOptions.getMatchSwitches . Input.SearchOptions.getStandardOpeningOptions $ searchOptions-		fullyManual						= Data.Map.null searchDepthByLogicalColour+		fullyManual						= Data.Foldable.null searchDepthByLogicalColour  		uiOptions	= Input.IOOptions.getUIOptions ioOptions @@ -243,7 +235,7 @@ 		\cecpOptions -> let 			displaySAN	= Input.CECPOptions.getDisplaySAN cecpOptions -			onCommand :: UI.Command.Command x y -> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+			onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState pieceSquareValue positionHash) 			onCommand UI.Command.Hint	= do 				Control.Monad.unless (Model.Game.isTerminated game) . Data.Maybe.maybe ( 					do@@ -261,13 +253,15 @@ 								) ( 									flip (ContextualNotation.StandardAlgebraic.showTurn explicitEnpassant) game 								) . Model.Game.maybeLastTurn $ Evaluation.QuantifiedGame.getGame quantifiedGame-								else Notation.MoveNotation.showNotation moveNotation $ Evaluation.QuantifiedGame.getLastTurn (quantifiedGame :: Evaluation.QuantifiedGame.QuantifiedGame x y)+								else Notation.MoveNotation.showNotation moveNotation $ Evaluation.QuantifiedGame.getLastTurn (quantifiedGame :: Evaluation.QuantifiedGame.QuantifiedGame) 							_		-> Control.Exception.throwIO . Data.Exception.mkRequestFailure . showString "BishBosh.UI.CECP.readMove.slave.onCommand:\tunexpectedly failed to find any moves; " $ shows game "."	-- CAVEAT: the game should have been terminated. 				 ) ( 					\(qualifiedMove, _) -> putStrLn . showString hintTag . showChar ' ' $ if displaySAN 						then ContextualNotation.StandardAlgebraic.showMove explicitEnpassant qualifiedMove game 						else Notation.MoveNotation.showNotation moveNotation qualifiedMove-				 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen tryToMatchSwitches game positionHashQualifiedMoveTree+				 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen (+					Input.StandardOpeningOptions.getPreferVictories . Input.SearchOptions.getStandardOpeningOptions $ searchOptions+				 ) tryToMatchSwitches game positionHashQualifiedMoveTree  				return {-to IO-monad-} playState	-- N.B.: though one could merely call "eventLoop", a new random-generator is desirable in case an alternative hint is requested. 			onCommand (UI.Command.Print printObject)	= do@@ -293,9 +287,7 @@ 						UI.ReportObject.FEN			-> return {-to IO-monad-} . Property.ForsythEdwards.showFEN 						UI.ReportObject.Game			-> return {-to IO-monad-} . show 						UI.ReportObject.MaxPositionInstances	-> return {-to IO-monad-} . show . State.InstancesByPosition.findMaximumInstances . Model.Game.getInstancesByPosition-						UI.ReportObject.Moves			-> return {-to IO-monad-} . showString (-							showString Component.Move.tag "s"-						 ) . Text.ShowList.showsAssociation . ($ ".") . Text.ShowList.showsFormattedList' (+						UI.ReportObject.Moves			-> return {-to IO-monad-} . ($ "") . Text.ShowList.showsFormattedList' ( 							Notation.MoveNotation.showsNotation moveNotation 						 ) . Model.Game.listTurnsChronologically 						UI.ReportObject.PGN			-> fmap ($ ".") . ContextualNotation.PGN.showsGame@@ -316,16 +308,7 @@ 						else showString " & leaving " . shows modeNames 				 ) "." -				Data.Maybe.maybe (-					return {-to IO-monad-} ()-				 ) (-					\(filePath, _) -> Control.Exception.catch (-						do-							System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` (Data.Default.def :: Model.Game.Game Type.Length.X Type.Length.Y))--							Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "the game-state has been saved in " $ shows filePath "."-					) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixError $ show (e :: Control.Exception.SomeException)-				 ) $ Input.IOOptions.getMaybePersistence ioOptions+				Input.IOOptions.persist ioOptions False (Data.Default.def :: Model.Game.Game)  				return {-to IO-monad-} $ State.PlayState.resetPositionHashQuantifiedGameTree playState { 					State.PlayState.getOptions	= options {@@ -337,14 +320,14 @@ 					} 				} 			onCommand (UI.Command.RollBack maybeNPlies)	= let-				rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+				rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState pieceSquareValue positionHash) 				rollBack nPlies 					| (game', _) : _ <- drop (fromIntegral $ pred nPlies) $ Model.Game.rollBack game	= return {-to IO-monad-} $ State.PlayState.reconstructPositionHashQuantifiedGameTree game' playState 					| otherwise										= onCommand UI.Command.Restart 			 in Data.Maybe.maybe ( 				let 					nPlies :: Type.Count.NPlies-					nPlies	= fromIntegral . succ $ Data.Map.size searchDepthByLogicalColour	-- In fully manual play, rollback one ply, in semi-manual play rollback two plies.+					nPlies	= fromIntegral . succ $ Data.Foldable.length searchDepthByLogicalColour	-- In fully manual play, rollback one ply, in semi-manual play rollback two plies. 				in do 					Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "rolling-back " $ shows nPlies " plies." @@ -367,31 +350,32 @@ 				 ) >>= System.IO.hPutStrLn System.IO.stderr  				eventLoop-			onCommand (UI.Command.Set setObject)-				| fullyManual	= do-					Control.Monad.when (verbosity >= Data.Default.def) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixWarning $ shows UI.Command.setTag " requires an automated opponent."+			onCommand (UI.Command.Set setObject)	= Control.Exception.catchJust (+				\e -> if Data.Exception.isBadData e+					then Just $ show e+					else Nothing+			 ) (+				do+					Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "setting " $ shows setObject "." -					return {-to IO-monad-} playState-				| otherwise					= Control.Exception.catchJust (-					\e -> if Data.Exception.isBadData e-						then Just $ show e-						else Nothing-				) (-					do-						Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "setting " $ shows setObject "."+					case setObject of+						UI.SetObject.EPD game'	-> slave runningWatch $ State.PlayState.reconstructPositionHashQuantifiedGameTree game' playState	-- Recurse.+						UI.SetObject.SearchDepth searchDepth+							| fullyManual	-> do+								Control.Monad.when (verbosity >= Data.Default.def) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixWarning $ shows UI.Command.setTag " requires an automated opponent." -						slave runningWatch playState {-							State.PlayState.getOptions	= Control.DeepSeq.force $ case setObject of-								UI.SetObject.SearchDepth searchDepth	-> options {+								eventLoop+							| otherwise	-> slave runningWatch playState {+								State.PlayState.getOptions	= Control.DeepSeq.force $ options { 									Input.Options.getSearchOptions	= Input.SearchOptions.setSearchDepth searchDepth $ Input.Options.getSearchOptions options 								}-						}-				) (-					\s -> do-						Control.Monad.unless (verbosity == minBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixError s+							} -- Recurse.+			 ) (+				\s -> do+					Control.Monad.unless (verbosity == minBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixError s -						eventLoop-				)+					eventLoop+			 ) 			onCommand UI.Command.Swap 				| fullyManual	= do 					Control.Monad.when (verbosity >= Data.Default.def) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixWarning . showString " there aren't any " $ shows Input.SearchOptions.searchDepthTag " to swap."@@ -402,7 +386,7 @@  					return {-to IO-monad-} playState { State.PlayState.getOptions = Input.Options.swapSearchDepth options } -			eventLoop :: IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+			eventLoop :: IO (State.PlayState.PlayState pieceSquareValue positionHash) 			eventLoop	= getLine >>= \line -> do 				Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "received \"" $ showString line "\"." @@ -532,7 +516,7 @@ 									eventLoop 								else let 									nextLogicalColour	= Model.Game.getNextLogicalColour game-								in if nextLogicalColour `Data.Map.member` searchDepthByLogicalColour+								in if nextLogicalColour `Map.member` searchDepthByLogicalColour 									then return {-to IO-monad-} playState { State.PlayState.getOptions = options' } 									else do 										Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "swapping to play " $ shows nextLogicalColour ", i.e. next."@@ -557,7 +541,7 @@ 							\playState' -> let 								engineLogicalColour	= minBound 								options'		= State.PlayState.getOptions playState'-							in if Data.Map.member engineLogicalColour . Input.SearchOptions.getSearchDepthByLogicalColour $ Input.Options.getSearchOptions options'+							in if Map.member engineLogicalColour . Input.SearchOptions.getSearchDepthByLogicalColour $ Input.Options.getSearchOptions options' 								then return {-to IO-monad-} playState' 								else do 									Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "swapping to play " $ shows engineLogicalColour "."@@ -811,7 +795,7 @@ 								] ++ map show [ 									Data.Maybe.fromMaybe ( 										Control.Exception.throw . Data.Exception.mkNullDatum . showString "BishBosh.UI.CECP.readMove.slave.eventLoop:\tundefined " $ shows Input.Options.tag "."-									) . Data.Maybe.listToMaybe $ Data.Map.elems searchDepthByLogicalColour,+									) . Data.Maybe.listToMaybe $ Data.Foldable.toList searchDepthByLogicalColour, 									Input.SearchOptions.minimumSearchDepth, 									7	-- Arbitrary maximum. 								]@@ -989,7 +973,7 @@  					maybePaused	= Input.CECPOptions.getMaybePaused cecpOptions -					moveCommand :: String -> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+					moveCommand :: String -> IO (State.PlayState.PlayState pieceSquareValue positionHash) 					moveCommand moveString	= case Notation.MoveNotation.readsQualifiedMove moveNotation moveString of 						[(eitherQualifiedMove, "")] 							| Just errorMessage <- Model.Game.validateEitherQualifiedMove eitherQualifiedMove game	-> do@@ -1039,35 +1023,28 @@ 	 ) $ Input.UIOptions.getEitherNativeUIOrCECPOptions uiOptions  -- | Plays the game.-takeTurns :: forall pieceSquareValue positionHash randomGen x y. (-	Control.DeepSeq.NFData					pieceSquareValue,-	Control.DeepSeq.NFData					x,-	Control.DeepSeq.NFData					y,-	Data.Array.IArray.Ix					x,+takeTurns :: forall pieceSquareValue positionHash randomGen. (+	Control.DeepSeq.NFData		pieceSquareValue, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Ord							positionHash,-	Real							pieceSquareValue,-	Show							pieceSquareValue,-	Show							x,-	Show							y,-	System.Random.RandomGen					randomGen+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Ord				positionHash,+	Real				pieceSquareValue,+	Show				pieceSquareValue,+	System.Random.RandomGen		randomGen  )-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree x y positionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen-	-> State.PlayState.PlayState pieceSquareValue positionHash x y-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+	-> State.PlayState.PlayState pieceSquareValue positionHash+	-> IO (State.PlayState.PlayState pieceSquareValue positionHash) {-# SPECIALISE takeTurns 	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash 	-> randomGen-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y)+	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash+	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)  #-} takeTurns positionHashQualifiedMoveTree randomGen playState	= do 	mVar	<- Control.Concurrent.newEmptyMVar@@ -1086,11 +1063,11 @@ 		verbosity	= Input.UIOptions.getVerbosity uiOptions  		slave-			:: Maybe (Concurrent.Pondering.Pondering (Component.Move.Move x y))+			:: Maybe (Concurrent.Pondering.Pondering Component.Move.Move) 			-> Maybe Type.Count.NPlies 			-> [randomGen]-			-> State.PlayState.PlayState pieceSquareValue positionHash x y-			-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+			-> State.PlayState.PlayState pieceSquareValue positionHash+			-> IO (State.PlayState.PlayState pieceSquareValue positionHash) 		slave maybePondering maybeMaximumPlies ~(randomGen' : randomGens) playState'	= let 			(game', (searchOptions', uiOptions'))	= State.PlayState.getGame &&& (Input.Options.getSearchOptions &&& Input.IOOptions.getUIOptions . Input.Options.getIOOptions) . State.PlayState.getOptions $ playState'	-- Deconstruct. 			(ponderMode, isPostMode)		= const (@@ -1157,7 +1134,7 @@ 												then Property.ShowFloat.showsFloatToN nDecimalDigits ( 													Control.Monad.Reader.runReader ( 														Evaluation.Fitness.evaluateFitness Nothing game'-													) evaluationOptions	:: Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues+													) evaluationOptions 												) . Search.Search.showsSeparator	-- Prepend the fitness of the original game prior to the result. 												else id 										 ) . Notation.MoveNotation.showsNotationFloatToNDecimals moveNotation nDecimalDigits searchResult' . showString " in " $ Property.ShowFloat.showsFloatToN nDecimalDigits stoppedWatch "s."@@ -1232,24 +1209,18 @@ 							putStrLn . showString moveTag . showChar ' ' $ Notation.MoveNotation.showNotation moveNotation qualifiedMove	-- Send the move to the GUI.  							return {-to IO-monad-} (State.PlayState.updateWithManualMove selectedGame playState', Nothing)	-- N.B.: one could ponder, but would have to construct a game-tree, & the chance of a subsequent standard-opening move is high.-					 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen' (-						Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions+					 ) $ uncurry (+						ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen'+					 ) (+						Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions 					 ) game' positionHashQualifiedMoveTree	-- Determine whether the automated player's move can be decided by a search of recorded games or we must decide ourself. 				 ) ( 					if Input.UIOptions.isCECPManualMode uiOptions' 						then Nothing-						else Model.Game.getNextLogicalColour game' `Data.Map.lookup` Input.SearchOptions.getSearchDepthByLogicalColour searchOptions'+						else Model.Game.getNextLogicalColour game' `Map.lookup` Input.SearchOptions.getSearchDepthByLogicalColour searchOptions' 				 ) >>= ( 					\(playState'', maybePondering') -> do-						Data.Maybe.maybe (-							return {-to IO-monad-} ()-						 ) (-							\(filePath, automatic) -> let-								game''	= State.PlayState.getGame playState''-							in Control.Monad.when automatic . Control.Exception.catch (-								System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'')-							) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixError $ show (e :: Control.Exception.SomeException)-						 ) $ Input.IOOptions.getMaybePersistence ioOptions+						Input.IOOptions.persist ioOptions False $ State.PlayState.getGame playState''  						if State.PlayState.hasApplicationTerminationBeenRequested playState'' 							then return {-to IO-monad-} playState''

@@ -68,7 +68,6 @@ import qualified	BishBosh.Time.StopWatch						as Time.StopWatch import qualified	BishBosh.Type.Count						as Type.Count import qualified	BishBosh.Type.Crypto						as Type.Crypto-import qualified	BishBosh.Type.Length						as Type.Length import qualified	BishBosh.Type.Mass						as Type.Mass import qualified	BishBosh.UI.Command						as UI.Command import qualified	BishBosh.UI.PrintObject						as UI.PrintObject@@ -79,11 +78,11 @@ import qualified	Control.Exception import qualified	Control.Monad import qualified	Control.Monad.Reader-import qualified	Data.Array.IArray import qualified	Data.Bits import qualified	Data.Default+import qualified	Data.Foldable import qualified	Data.List.Extra-import qualified	Data.Map+import qualified	Data.Map.Strict							as Map import qualified	Data.Maybe import qualified	System.IO import qualified	System.Random@@ -98,46 +97,37 @@  	* Since the user can also request roll-back to an earlier game before then requesting a new move, a new game is returned rather than just the requested move. -}-readMove :: forall pieceSquareValue positionHash randomGen x y. (-	Control.DeepSeq.NFData					pieceSquareValue,-	Control.DeepSeq.NFData					x,-	Control.DeepSeq.NFData					y,-	Data.Array.IArray.Ix					x,+readMove :: forall pieceSquareValue positionHash randomGen. (+	Control.DeepSeq.NFData		pieceSquareValue, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Ord							positionHash,-	Read							x,-	Read							y,-	Real							pieceSquareValue,-	Show							pieceSquareValue,-	Show							x,-	Show							y,-	System.Random.RandomGen					randomGen+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Ord				positionHash,+	Real				pieceSquareValue,+	Show				pieceSquareValue,+	System.Random.RandomGen		randomGen  )-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree x y positionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen 	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState pieceSquareValue positionHash x y-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+	-> State.PlayState.PlayState pieceSquareValue positionHash+	-> IO (State.PlayState.PlayState pieceSquareValue positionHash) {-# SPECIALISE readMove 	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash 	-> randomGen 	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y)+	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash+	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)  #-} readMove positionHashQualifiedMoveTree randomGen runningWatch playState	= let 	(game, options)			= State.PlayState.getGame &&& State.PlayState.getOptions $ playState 	(searchOptions, ioOptions)	= Input.Options.getSearchOptions &&& Input.Options.getIOOptions $ options  	searchDepthByLogicalColour	= Input.SearchOptions.getSearchDepthByLogicalColour searchOptions-	fullyManual			= Data.Map.null searchDepthByLogicalColour+	fullyManual			= Data.Foldable.null searchDepthByLogicalColour  	(uiOptions, maybeMaximumPGNNames)	= Input.IOOptions.getUIOptions &&& Input.IOOptions.getMaybeMaximumPGNNames $ ioOptions @@ -146,14 +136,18 @@ 	verbosity	= Input.UIOptions.getVerbosity uiOptions  in ( 	\nativeUIOptions -> let-		show2D :: Model.Game.Game x y -> String-		show2D	= uncurry State.MaybePieceByCoordinates.show2D (-			snd {-columns-} . Input.NativeUIOptions.getBoardMagnification &&& Input.NativeUIOptions.getColourScheme $ nativeUIOptions+		show2D :: Model.Game.Game -> String+		show2D	= State.MaybePieceByCoordinates.show2D (+			snd {-columns-} $ Input.NativeUIOptions.getBoardMagnification nativeUIOptions 		 ) (+			Input.NativeUIOptions.getColourScheme nativeUIOptions+		 ) (+			Input.NativeUIOptions.getDepictFigurine nativeUIOptions+		 ) ( 			Notation.MoveNotation.getOrigin moveNotation 		 ) . State.Board.getMaybePieceByCoordinates . Model.Game.getBoard -		onCommand :: UI.Command.Command x y -> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+		onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState pieceSquareValue positionHash) 		onCommand UI.Command.Hint	= do 			Control.Monad.unless (Model.Game.isTerminated game) . Data.Maybe.maybe ( 				do@@ -175,8 +169,10 @@ 						_		-> Control.Exception.throwIO . Data.Exception.mkRequestFailure . showString "BishBosh.UI.Raw.readMove.onCommand:\tunexpectedly failed to find any moves; " $ shows game "."	-- CAVEAT: the game should have terminated. 			 ) ( 				\(qualifiedMove, names) -> putStrLn . Text.ShowColouredPrefix.showsPrefixInfo . showString "Try \"" . Notation.MoveNotation.showsNotation moveNotation qualifiedMove . showString "\" from:" $ ContextualNotation.QualifiedMoveForest.showsNames maybeMaximumPGNNames names ""-			 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen (-				Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions+			 ) $ uncurry (+				ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen+			 ) (+				Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions 			 ) game positionHashQualifiedMoveTree  			return {-to IO-monad-} playState	-- N.B.: though one could merely call "eventLoop", a new random-generator is desirable in case an alternative hint is requested.@@ -202,9 +198,7 @@ 				UI.ReportObject.FEN			-> putStrLn . Property.ForsythEdwards.showFEN 				UI.ReportObject.Game			-> print 				UI.ReportObject.MaxPositionInstances	-> print . State.InstancesByPosition.findMaximumInstances . Model.Game.getInstancesByPosition-				UI.ReportObject.Moves			-> putStrLn . showString (-					showString Component.Move.tag "s"-				 ) . Text.ShowList.showsAssociation . ($ ".") . Text.ShowList.showsFormattedList' (+				UI.ReportObject.Moves			-> putStrLn . ($ "") . Text.ShowList.showsFormattedList' ( 					Notation.MoveNotation.showsNotation moveNotation 				 ) . Model.Game.listTurnsChronologically 				UI.ReportObject.PGN			-> putStrLn . ($ ".") <=< ContextualNotation.PGN.showsGame@@ -218,20 +212,11 @@ 		onCommand UI.Command.Restart	= do 			Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "restarting game." -			Data.Maybe.maybe (-				return {-to IO-monad-} ()-			 ) (-				\(filePath, _) -> Control.Exception.catch (-					do-						System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` (Data.Default.def :: Model.Game.Game Type.Length.X Type.Length.Y))--						Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "the initial game-state has been saved in " $ shows filePath "."-				) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixError $ show (e :: Control.Exception.SomeException)-			 ) $ Input.IOOptions.getMaybePersistence ioOptions+			Input.IOOptions.persist ioOptions (verbosity == maxBound) (Data.Default.def :: Model.Game.Game)  			return {-to IO-monad-} $ State.PlayState.resetPositionHashQuantifiedGameTree playState 		onCommand (UI.Command.RollBack maybeNPlies)	= let-			rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+			rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState pieceSquareValue positionHash) 			rollBack nPlies 				| (game', _) : _ <- drop (fromIntegral $ pred nPlies) $ Model.Game.rollBack game	= do 					Control.Monad.when (verbosity == maxBound) . putStrLn $ show2D game'@@ -241,7 +226,7 @@ 		 in Data.Maybe.maybe ( 			let 				nPlies :: Type.Count.NPlies-				nPlies	= fromIntegral . succ $ Data.Map.size searchDepthByLogicalColour	-- In fully manual play, rollback one ply, in semi-manual play rollback two plies.+				nPlies	= fromIntegral . succ $ Data.Foldable.length searchDepthByLogicalColour	-- In fully manual play, rollback one ply, in semi-manual play rollback two plies. 			in do 				Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "rolling-back " $ shows nPlies " plies." @@ -264,31 +249,35 @@ 			 ) >>= System.IO.hPutStrLn System.IO.stderr  			eventLoop-		onCommand (UI.Command.Set setObject)-			| fullyManual	= do-				System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixWarning $ shows UI.Command.setTag " requires an automated opponent."+		onCommand (UI.Command.Set setObject)	= Control.Exception.catchJust (+			\e -> if Data.Exception.isBadData e+				then Just $ show e+				else Nothing+		 ) (+			do+				Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "setting " $ shows setObject "." -				return {-to IO-monad-} playState-			| otherwise	= Control.Exception.catchJust (-				\e -> if Data.Exception.isBadData e-					then Just $ show e-					else Nothing-			) (-				do-					Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "setting " $ shows setObject "."+				case setObject of+					UI.SetObject.EPD game'	-> do+						Control.Monad.when (verbosity == maxBound) . putStrLn $ show2D game' -					readMove positionHashQualifiedMoveTree randomGen runningWatch playState {-						State.PlayState.getOptions	= Control.DeepSeq.force $ case setObject of-							UI.SetObject.SearchDepth searchDepth	-> options {+						readMove positionHashQualifiedMoveTree randomGen runningWatch $ State.PlayState.reconstructPositionHashQuantifiedGameTree game' playState	-- Recurse.+					UI.SetObject.SearchDepth searchDepth+						| fullyManual	-> do+							System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixWarning $ shows setObject " requires an automated opponent."++							eventLoop+						| otherwise	-> readMove positionHashQualifiedMoveTree randomGen runningWatch playState {+							State.PlayState.getOptions	= Control.DeepSeq.force $ options { 								Input.Options.getSearchOptions	= Input.SearchOptions.setSearchDepth searchDepth $ Input.Options.getSearchOptions options 							}-					} -- Recurse.-			) (-				\s -> do-					Control.Monad.unless (verbosity == minBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixError s+						} -- Recurse.+		 ) (+			\s -> do+				Control.Monad.unless (verbosity == minBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixError s -					eventLoop-			)+				eventLoop+		 ) 		onCommand UI.Command.Swap 			| fullyManual	= do 				Control.Monad.when (verbosity >= Data.Default.def) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixWarning . showString " there aren't any " $ shows Input.SearchOptions.searchDepthTag " to swap."@@ -299,7 +288,7 @@  				return {-to IO-monad-} playState { State.PlayState.getOptions = Input.Options.swapSearchDepth options } -		eventLoop :: IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+		eventLoop :: IO (State.PlayState.PlayState pieceSquareValue positionHash) 		eventLoop	= getLine >>= \line -> case Data.List.Extra.trim line of 			"?"	-> onCommand $ UI.Command.Print UI.PrintObject.Help 			':' : s	-> (@@ -370,37 +359,28 @@  ) $ Input.UIOptions.getEitherNativeUIOrCECPOptions uiOptions  -- | Plays the game.-takeTurns :: forall pieceSquareValue positionHash randomGen x y. (-	Control.DeepSeq.NFData					pieceSquareValue,-	Control.DeepSeq.NFData					x,-	Control.DeepSeq.NFData					y,-	Data.Array.IArray.Ix					x,+takeTurns :: forall pieceSquareValue positionHash randomGen. (+	Control.DeepSeq.NFData		pieceSquareValue, #ifdef USE_UNBOXED_ARRAYS-	Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray	pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size).+	Data.Array.Unboxed.IArray	Data.Array.Unboxed.UArray pieceSquareValue,	-- Requires 'FlexibleContexts'. The unboxed representation of the array-element must be defined (& therefore must be of fixed size). #endif-	Data.Bits.Bits						positionHash,-	Fractional						pieceSquareValue,-	Integral						x,-	Integral						y,-	Ord							positionHash,-	Read							x,-	Read							y,-	Real							pieceSquareValue,-	Show							pieceSquareValue,-	Show							x,-	Show							y,-	System.Random.RandomGen					randomGen+	Data.Bits.Bits			positionHash,+	Fractional			pieceSquareValue,+	Ord				positionHash,+	Real				pieceSquareValue,+	Show				pieceSquareValue,+	System.Random.RandomGen		randomGen  )-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree x y positionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen-	-> State.PlayState.PlayState pieceSquareValue positionHash x y-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+	-> State.PlayState.PlayState pieceSquareValue positionHash+	-> IO (State.PlayState.PlayState pieceSquareValue positionHash) {-# SPECIALISE takeTurns 	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash+	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash 	-> randomGen-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y)+	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash+	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)  #-} takeTurns positionHashQualifiedMoveTree randomGen playState	= let 	options	= State.PlayState.getOptions playState@@ -417,19 +397,23 @@ 		mVar	<- Control.Concurrent.newEmptyMVar  		let-			show2D :: Model.Game.Game x y -> String-			show2D	= uncurry State.MaybePieceByCoordinates.show2D (-				snd {-columns-} . Input.NativeUIOptions.getBoardMagnification &&& Input.NativeUIOptions.getColourScheme $ nativeUIOptions+			show2D :: Model.Game.Game -> String+			show2D	= State.MaybePieceByCoordinates.show2D (+				snd {-columns-} $ Input.NativeUIOptions.getBoardMagnification nativeUIOptions 			 ) (+				Input.NativeUIOptions.getColourScheme nativeUIOptions+			 ) (+				Input.NativeUIOptions.getDepictFigurine nativeUIOptions+			 ) ( 				Notation.MoveNotation.getOrigin moveNotation 			 ) . State.Board.getMaybePieceByCoordinates . Model.Game.getBoard  			slave-				:: Maybe (Concurrent.Pondering.Pondering (Component.Move.Move x y))+				:: Maybe (Concurrent.Pondering.Pondering Component.Move.Move) 				-> Maybe Type.Count.NPlies 				-> [randomGen]-				-> State.PlayState.PlayState pieceSquareValue positionHash x y-				-> IO (State.PlayState.PlayState pieceSquareValue positionHash x y)+				-> State.PlayState.PlayState pieceSquareValue positionHash+				-> IO (State.PlayState.PlayState pieceSquareValue positionHash) 			slave maybePondering maybeMaximumPlies ~(randomGen' : randomGens) playState'	= let 				(game', searchOptions')		= State.PlayState.getGame &&& Input.Options.getSearchOptions . State.PlayState.getOptions $ playState'	-- Deconstruct. 			 in Data.Maybe.maybe (@@ -495,7 +479,7 @@ 															then Property.ShowFloat.showsFloatToN nDecimalDigits ( 																Control.Monad.Reader.runReader ( 																	Evaluation.Fitness.evaluateFitness Nothing game'-																) $ Input.Options.getEvaluationOptions options	:: Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues+																) $ Input.Options.getEvaluationOptions options 															) . Search.Search.showsSeparator	-- Prepend the fitness of the original game prior to the new result. 															else id 													 ) $ if verbosity > Data.Default.def@@ -550,25 +534,16 @@ 										putStrLn $ show2D selectedGame  								return {-to IO-monad-} (State.PlayState.updateWithManualMove selectedGame playState', Nothing)	-- N.B.: one could ponder, but would have to construct a game-tree, & the chance of a subsequent standard-opening move is high.-						 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen' (-							Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions+						 ) $ uncurry (+							ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen'+						 ) (+							Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions 						 ) game' positionHashQualifiedMoveTree	-- Determine whether the automated player's move can be decided by a search of recorded games or we must decide ourself. 					 ) (-						Model.Game.getNextLogicalColour game' `Data.Map.lookup` Input.SearchOptions.getSearchDepthByLogicalColour searchOptions'	-- Determinate whether the next player is manual.+						Model.Game.getNextLogicalColour game' `Map.lookup` Input.SearchOptions.getSearchDepthByLogicalColour searchOptions'	-- Determinate whether the next player is manual. 					 ) >>= ( 						\(playState'', maybePondering') -> do-							Data.Maybe.maybe (-								return {-to IO-monad-} ()-							 ) (-								\(filePath, automatic) -> let-									game''	= State.PlayState.getGame playState''-								in Control.Monad.when automatic . Control.Exception.catch (-									do-										System.IO.withFile filePath System.IO.WriteMode (`System.IO.hPrint` game'')--										Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "the game-state has been saved in " $ shows filePath "."-								) $ \e -> System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixError $ show (e :: Control.Exception.SomeException)-							 ) $ Input.IOOptions.getMaybePersistence ioOptions+							Input.IOOptions.persist ioOptions (verbosity == maxBound) $ State.PlayState.getGame playState''  							if State.PlayState.hasApplicationTerminationBeenRequested playState'' 								then return {-to IO-monad-} playState''

@@ -26,7 +26,9 @@ module Duel.Process.Intermediary ( -- * Types -- ** Type-synonyms+--	MoveNotation, --	IOHandles,+--	MoveSequence, --	GameTerminationReasonsMap, -- * Functions --	runBishBosh,@@ -47,10 +49,12 @@ import qualified	BishBosh.Input.CommandLineOption	as Input.CommandLineOption import qualified	BishBosh.Input.IOOptions		as Input.IOOptions import qualified	BishBosh.Input.Options			as Input.Options+import qualified	BishBosh.Input.PGNOptions		as Input.PGNOptions import qualified	BishBosh.Input.SearchOptions		as Input.SearchOptions import qualified	BishBosh.Input.UIOptions		as Input.UIOptions import qualified	BishBosh.Input.Verbosity		as Input.Verbosity import qualified	BishBosh.Notation.MoveNotation		as Notation.MoveNotation+import qualified	BishBosh.Property.Empty			as Property.Empty import qualified	BishBosh.Property.Opposable		as Property.Opposable import qualified	BishBosh.Property.SelfValidating	as Property.SelfValidating import qualified	BishBosh.Property.Switchable		as Property.Switchable@@ -58,13 +62,14 @@ import qualified	BishBosh.Text.ShowList			as Text.ShowList import qualified	BishBosh.Time.GameClock			as Time.GameClock import qualified	BishBosh.Type.Count			as Type.Count-import qualified	BishBosh.Type.Length			as Type.Length import qualified	BishBosh.Type.Mass			as Type.Mass import qualified	BishBosh.UI.Command			as UI.Command+import qualified	BishBosh.UI.ReportObject		as UI.ReportObject import qualified	Control.Exception import qualified	Control.Monad import qualified	Data.Default-import qualified	Data.Map.Strict+import qualified	Data.Foldable+import qualified	Data.Map.Strict				as Map import qualified	Data.Maybe import qualified	Duel.Data.Options			as Data.Options import qualified	Duel.IO.Logger				as IO.Logger@@ -85,7 +90,7 @@ import qualified	BishBosh.Notation.Smith			as Notation.Smith type MoveNotation	= Notation.Smith.Smith #	else-#		error "MOVE_NOTATION ill-defined"+#		error "MOVE_NOTATION invalid" #	endif #else #	error "MOVE_NOTATION undefined"@@ -116,7 +121,7 @@ 	-> Type.Count.NSeconds				-- ^ Read-timout. 	-> Attribute.LogicalColour.LogicalColour	-- ^ Whose turn it is. 	-> System.IO.Handle				-- ^ Output handle from which data should be read.-	-> IO (Either Rule.GameTerminationReason.GameTerminationReason (MoveNotation Type.Length.X Type.Length.Y))+	-> IO (Either Rule.GameTerminationReason.GameTerminationReason MoveNotation) readMove verbosity readTimeout logicalColour stdOut = do 	Control.Monad.when (verbosity == maxBound) . IO.Logger.printInfo . showString "Waiting " . ( 		if readTimeout < 0@@ -132,7 +137,7 @@  	case reads line of 		[(gameTerminationReason, "")]	-> do-			Control.Monad.when (verbosity > minBound) . IO.Logger.printInfo $ shows gameTerminationReason " => game over."+			Control.Monad.when (verbosity /= minBound) . IO.Logger.printInfo $ shows gameTerminationReason " => game over."  			return {-to IO-monad-} $ Left gameTerminationReason	-- Return the result. 		_				-> case reads line of@@ -161,6 +166,9 @@ -- | Contains /stdin/ & /stdout/ handles respectively. type IOHandles	= (System.IO.Handle, System.IO.Handle) +-- | The chronological sequence of moves which occurred in a game.+type MoveSequence	= String+ -- | Shuttle moves between the two child processes until the game terminates. play 	:: Property.Switchable.Switchable gameClock@@ -169,7 +177,7 @@ 	-> IOHandles 	-> IOHandles 	-> gameClock-	-> IO (Rule.GameTerminationReason.GameTerminationReason, gameClock)+	-> IO (MoveSequence, Rule.GameTerminationReason.GameTerminationReason, gameClock) play verbosity readTimeout	= slave maxBound	where 	slave logicalColour producer@(_, stdOut) consumer@(stdIn', stdOut') gameClock	= copyMove verbosity readTimeout logicalColour stdOut stdIn' >>= Data.Maybe.maybe ( 		do@@ -182,7 +190,11 @@ 				\gameTerminationReason' -> do 					Control.Monad.unless (gameTerminationReason == gameTerminationReason') . Control.Exception.throwIO . Data.Exception.mkIncompatibleData . showString "Duel.Process.Intermediary.play:\tsecond game terminated for a different reason; " $ shows gameTerminationReason' "." -					return {-to IO-monad-} (gameTerminationReason, gameClock)+					System.IO.hPutStrLn stdIn' $ UI.Command.issueCommand (UI.Command.Report UI.ReportObject.Moves) ""	-- Request the move-sequence, for comparison with the other games in this trial.++					moveSequence	<- System.IO.hGetLine stdOut'	-- CAVEAT: no attempt is made to parse the move-sequence.++					return {-to IO-monad-} (moveSequence, gameTerminationReason, gameClock) 			 ) ||| ( 				\move	-> Control.Exception.throwIO . Data.Exception.mkParseFailure . showString "Duel.Process.Intermediary.play:\tread from " . shows (Property.Opposable.getOpposite logicalColour) . showString ", unexpected move='" $ shows move "'." 			 )@@ -195,12 +207,8 @@  	Control.Monad.when isReady . Control.Monad.void $ System.IO.hGetLine handle -{- |-	* Accumulates the frequency of each game-termination reason--	* N.B.: the recorded result is merely a string, though it could be read into a 'BishBosh.Rule.GameTerminationReason'.--}-type GameTerminationReasonsMap	= Data.Map.Strict.Map Rule.GameTerminationReason.GameTerminationReason Type.Count.NGames+-- | Accumulates the frequency-distribution of game-termination reasons.+type GameTerminationReasonsMap	= Map.Map Rule.GameTerminationReason.GameTerminationReason Type.Count.NGames  {- | 	* Constructs a game-clock.@@ -214,6 +222,8 @@ 	* Plays repeatedly, measuring both the total time taken by each side & accumulating the final results of each game.  	* Prints the total time taken by either side, & returns the accumulated results of each game.++	* Reports games which are duplicated; transpositions are considered to be different. -} startGame 	:: Input.Verbosity.Verbosity@@ -224,16 +234,25 @@ 	-> GameTerminationReasonsMap 	-> Type.Count.NGames 	-> IO GameTerminationReasonsMap-startGame verbosity nDecimalDigits readTimeout producer consumer gameTerminationReasonsMap nGames	= Property.Switchable.on >>= slave gameTerminationReasonsMap nGames where-	slave :: GameTerminationReasonsMap -> Type.Count.NGames -> Time.GameClock.GameClock -> IO GameTerminationReasonsMap-	slave gameTerminationReasonsMap' 0 gameClock	= do+startGame verbosity nDecimalDigits readTimeout producer consumer gameTerminationReasonsMap nGames	= Property.Switchable.on >>= slave Property.Empty.empty gameTerminationReasonsMap nGames where+	accumulateFrequencyDistribution :: (Enum i, Num i, Ord k) => k -> Map.Map k i -> Map.Map k i+	accumulateFrequencyDistribution	= flip (Map.insertWith $ const succ) 1++	slave :: Map.Map MoveSequence Type.Count.NGames -> GameTerminationReasonsMap -> Type.Count.NGames -> Time.GameClock.GameClock -> IO GameTerminationReasonsMap+	slave moveSequenceMap gameTerminationReasonsMap' 0 gameClock	= do 		Time.GameClock.showsElapsedTimes nDecimalDigits gameClock >>= IO.Logger.printInfo . showString "Elapsed time" . Text.ShowList.showsAssociation . ($ ".") +		let duplicatedMovesMap	= Map.filter (> 1) moveSequenceMap++		if Data.Foldable.null duplicatedMovesMap+			then Control.Monad.when (verbosity == maxBound) $ IO.Logger.printInfo "All games were composed from unique move-sequences."+			else Control.Monad.unless (verbosity == minBound) . IO.Logger.printWarning . showString "Duplicated move-sequences:\t" $ shows (Map.toList duplicatedMovesMap) "."+ 		return {-to IO-monad-} gameTerminationReasonsMap'-	slave gameTerminationReasonsMap' nGames' gameClock	= do+	slave moveSequenceMap gameTerminationReasonsMap' nGames' gameClock	= do 		Control.Monad.when (verbosity == maxBound) $ IO.Logger.printInfo "Starting game." -		(gameTerminationReason, gameClock')	<- play verbosity readTimeout producer consumer gameClock+		(moveSequence, gameTerminationReason, gameClock')	<- play verbosity readTimeout producer consumer gameClock  		sequence_ $ [ 			\(_, stdOut) -> do@@ -243,12 +262,14 @@ 			\(stdIn, _) -> do 				Control.Monad.when (verbosity == maxBound) $ IO.Logger.printInfo "Requesting restart." -				System.IO.hPutStrLn stdIn $ UI.Command.commandPrefix : UI.Command.restartTag+				System.IO.hPutStrLn stdIn $ UI.Command.issueCommand UI.Command.Restart "" 		 ] <*> [consumer, producer]  		slave (-			Data.Map.Strict.insertWith (const succ) gameTerminationReason 1 gameTerminationReasonsMap'+			accumulateFrequencyDistribution moveSequence moveSequenceMap 		 ) (+			accumulateFrequencyDistribution gameTerminationReason gameTerminationReasonsMap'+		 ) ( 			pred nGames' -- Recurse. 		 ) gameClock' @@ -301,7 +322,7 @@ 	in Control.Exception.catch ( 		do 			Control.Monad.when (Data.Options.getVerifyConfiguration options) $ do-				[(logicalColoursFirst, moveNotationFirst), (logicalColoursSecond, moveNotationSecond)]	<- mapM (+				[(logicalColoursFirst, moveNotationFirst, unspecifiedPGNOptionsFirst), (logicalColoursSecond, moveNotationSecond, unspecifiedPGNOptionsSecond)]	<- mapM ( 					\configFilePath -> do 						[pair]	<- HXT.runX $ HXT.setTraceLevel hxtTraceLevel 							>>> HXT.xunpickleDocument HXT.xpickle [@@ -309,9 +330,13 @@ 								HXT.withStrictInput HXT.no	-- Only a fraction of the document is required. 							] configFilePath 							>>> HXT.arr (-								 \inputOptions -> Input.SearchOptions.identifyAutomatedPlayers . Input.Options.getSearchOptions &&& Input.UIOptions.getMoveNotation . Input.IOOptions.getUIOptions . Input.Options.getIOOptions $ (-									inputOptions	:: Input.Options.Options Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y	-- Arbitrary concrete type.-								 )+								\inputOptions -> (+									Input.SearchOptions.identifyAutomatedPlayers $ Input.Options.getSearchOptions (+										inputOptions	:: Input.Options.Options Type.Mass.PieceSquareValue	-- Arbitrary concrete type.+									),+									Input.UIOptions.getMoveNotation . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions inputOptions,+									null . Input.IOOptions.getPGNOptionsList $ Input.Options.getIOOptions inputOptions+								) 							) -- Lift function into an arrow.  						return {-to IO-monad-} pair@@ -321,13 +346,15 @@  				Control.Monad.unless (moveNotationFirst == moveNotationSecond) . Control.Exception.throwIO . Data.Exception.mkIncompatibleData . showString "Duel.Process.Intermediary.initialise:\tconfiguration-files must define the same " . showString Notation.MoveNotation.tag . Text.ShowList.showsAssociation $ shows (moveNotationFirst, moveNotationSecond) "." +				Control.Monad.when (unspecifiedPGNOptionsFirst && unspecifiedPGNOptionsSecond) . Control.Exception.throwIO . Data.Exception.mkNullDatum . showString "Duel.Process.Intermediary.initialise:\tto introduce randomness, at least one configuration-file must define '" . showString Input.PGNOptions.tag . showChar '.' $ showString Input.PGNOptions.databaseFilePathTag "'."+ 			bracketProcess verbosity inputConfigFilePaths $ \[handles, handles'] -> uncurry ( 				uncurry (startGame verbosity) $ (Data.Options.getNDecimalDigits &&& Data.Options.getReadTimeout) options 			 ) ( 				($ handles) &&& ($ handles') $ Process.Handles.getHandlePair-			 ) Data.Map.Strict.empty (+			 ) Property.Empty.empty ( 				Data.Options.getNGames options-			 ) >>= IO.Logger.printInfo . show . Data.Map.Strict.toList+			 ) >>= IO.Logger.printInfo . show . Map.toList 	) $ \e -> do 		IO.Logger.printError . showString "caught " $ show (e :: Control.Exception.SomeException) 

@@ -29,7 +29,6 @@  module Main(main) where ---import		BishBosh.Data.Ratio()	-- Required if either Type.Mass.CriterionWeight or Type.Mass.CriterionValue is Rational. import			Control.Arrow((&&&), (***), (|||)) import			Control.Category((>>>)) import			Data.Array.IArray((!))@@ -43,6 +42,7 @@ import qualified	BishBosh.Input.EvaluationOptions			as Input.EvaluationOptions import qualified	BishBosh.Input.IOOptions				as Input.IOOptions import qualified	BishBosh.Input.Options					as Input.Options+import qualified	BishBosh.Input.PieceSquareTable				as Input.PieceSquareTable import qualified	BishBosh.Input.PGNOptions				as Input.PGNOptions import qualified	BishBosh.Input.UIOptions				as Input.UIOptions import qualified	BishBosh.Input.Verbosity				as Input.Verbosity@@ -59,7 +59,6 @@ import qualified	BishBosh.Text.ShowPrefix				as Text.ShowPrefix import qualified	BishBosh.Type.Count					as Type.Count import qualified	BishBosh.Type.Crypto					as Type.Crypto-import qualified	BishBosh.Type.Length					as Type.Length import qualified	BishBosh.Type.Mass					as Type.Mass import qualified	Control.Exception import qualified	Control.Monad@@ -95,7 +94,7 @@ #endif  -- Define concrete types to resolve the underlying polymorphic functions.-type Options	= Input.Options.Options Type.Mass.PieceSquareValue Type.Length.X Type.Length.Y+type Options	= Input.Options.Options Type.Mass.PieceSquareValue  writeXMLToFile 	:: HXT.XmlPickler pickleable@@ -277,7 +276,11 @@ 					) ["Opening", "End"] 				) $ map ( 					\selector	-> Component.PieceSquareByCoordinatesByRank.formatForGNUPlot (-						Property.ShowFloat.showsFloatToN' . Input.UIOptions.getNDecimalDigits . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions options	-- PieceSquareValue formatter.+						Property.ShowFloat.showsFloatToN' (+							Input.UIOptions.getNDecimalDigits . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions options	-- PieceSquareValue formatter.+						) . (+							realToFrac	:: Type.Mass.PieceSquareValue -> Input.PieceSquareTable.IOFormat	-- N.B.: required when compiled with 'USE_PRECISION'.+						) 					) ( 						showChar '\t'	-- Column-delimiter. 					) (@@ -381,12 +384,12 @@  								System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering	-- CAVEAT: required when the output is another process instead of a terminal. -								playState	<- uncurry (Play.play randomGen) . (,) options' =<< (	-- CAVEAT: artificially construct a pair, to reduce the strictness & thus allow the UI to be rendered while PGN-databases are evaluated in the background.+								playState	<- uncurry (Play.play verbosity randomGen) . (,) options' =<< (	-- CAVEAT: artificially construct a pair, to reduce the strictness & thus allow the UI to be rendered while PGN-databases are evaluated in the background. 									\qualifiedMoveForest -> do 										Control.Monad.when (verbosity == maxBound && not (Property.Null.isNull qualifiedMoveForest)) $ mapM_ ( 											System.IO.hPutStrLn System.IO.stderr . showsInfoPrefix . ($ ".") 										 ) [-											showString "resulting tree contains (nGames, nMoves)" . Text.ShowList.showsAssociation . shows (ContextualNotation.QualifiedMoveForest.count qualifiedMoveForest),	-- CAVEAT: application stalls during this call.+											showString "resulting tree contains (nGames, nPositions)" . Text.ShowList.showsAssociation . shows (ContextualNotation.QualifiedMoveForest.count qualifiedMoveForest),	-- CAVEAT: application stalls during this call.  											showString "the minimum number of pieces remaining in any of the archived games" . Text.ShowList.showsAssociation . shows (ContextualNotation.QualifiedMoveForest.findMinimumPieces qualifiedMoveForest) 										 ]@@ -446,7 +449,7 @@ 								 ) Property.Empty.empty {-QualifiedMoveForest-} (Input.IOOptions.getPGNOptionsList ioOptions)  								let-									maybeApplicationTerminationReason	= State.PlayState.getMaybeApplicationTerminationReason (playState :: State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash Type.Length.X Type.Length.Y)+									maybeApplicationTerminationReason	= State.PlayState.getMaybeApplicationTerminationReason (playState :: State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash) 								 in Control.Monad.when ( 									verbosity /= minBound && Data.Maybe.isJust maybeApplicationTerminationReason 								 ) . System.IO.hPutStrLn System.IO.stderr . showsInfoPrefix . showString "application terminated " $ shows (Data.Maybe.fromJust maybeApplicationTerminationReason) "."

@@ -0,0 +1,76 @@+{-+	Copyright (C) 2021 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 the encoding of colours for rendering on a terminal; <https://en.wikipedia.org/wiki/ANSI_escape_code>.+-}++module BishBosh.Attribute.ANSIColourCode(+-- * Types+-- ** Type-synonyms+--	ANSIColourCode(),+--	IsBold,+	GraphicsRendition,+-- * Functions+	selectGraphicsRendition,+	bracket,+-- ** Constructors+	mkFgColourCode,+	mkBgColourCode+) where++import qualified	BishBosh.Attribute.PhysicalColour	as Attribute.PhysicalColour+import qualified	Data.Default++-- | A colour-code as used by terminal-emulators.+newtype ANSIColourCode	= MkANSIColourCode {+	deconstruct	:: Int+}++instance Show ANSIColourCode where+	showsPrec precedence MkANSIColourCode { deconstruct = i }	= showsPrec precedence i++instance Data.Default.Default ANSIColourCode where+	def	= MkANSIColourCode 0++-- | The font-weight of a character.+type IsBold	= Bool++-- | An escape-sequence used to control a terminal.+type GraphicsRendition	= String++-- | Constructor: offset the specified colour-code, so that it applies to the foreground.+mkFgColourCode :: Attribute.PhysicalColour.PhysicalColour -> ANSIColourCode+mkFgColourCode	= MkANSIColourCode . (+ 30) . fromEnum {-CAVEAT: relies on the PhysicalColour's constructor-order-}++-- | Constructor: offset the specified colour-code, so that it applies to the background.+mkBgColourCode :: Attribute.PhysicalColour.PhysicalColour -> ANSIColourCode+mkBgColourCode	= MkANSIColourCode . (+ 40) . fromEnum {-CAVEAT: relies on the PhysicalColour's constructor-order-}++-- | Generate the escape-sequence required to change a terminal to the specified physical colour.+selectGraphicsRendition :: IsBold -> ANSIColourCode -> GraphicsRendition+selectGraphicsRendition isBold parameter	= showString "\x1b[" . shows parameter $ (if isBold then showString ";1" else id) "m"++-- | Render the specified string according to instructions, then revert to the default.+bracket :: GraphicsRendition -> String -> ShowS+bracket graphicsRendition s	= showString graphicsRendition . showString s . showString (+	selectGraphicsRendition False Data.Default.def+ )+

@@ -19,7 +19,7 @@ {- |  [@AUTHOR@]	Dr. Alistair Ward - [@DESCRIPTION@]	Defines the physical colour used to represent each component of the display.+ [@DESCRIPTION@]	Defines the physical colour used to represent each component of the board. -}  module BishBosh.Attribute.ColourScheme (@@ -45,6 +45,7 @@  import qualified	BishBosh.Attribute.PhysicalColour	as Attribute.PhysicalColour import qualified	BishBosh.Data.Exception			as Data.Exception+import qualified	BishBosh.Property.Opposable		as Property.Opposable import qualified	BishBosh.Text.ShowList			as Text.ShowList import qualified	Control.Arrow import qualified	Control.DeepSeq@@ -105,9 +106,9 @@ instance Data.Default.Default ColourScheme where 	def = MkColourScheme { 		getDarkPieceColour	= Attribute.PhysicalColour.blue,-		getLightPieceColour	= Attribute.PhysicalColour.yellow,+		getLightPieceColour	= Property.Opposable.getOpposite $ getDarkPieceColour Data.Default.def, 		getDarkSquareColour	= Attribute.PhysicalColour.black,-		getLightSquareColour	= Attribute.PhysicalColour.white+		getLightSquareColour	= Property.Opposable.getOpposite $ getDarkSquareColour Data.Default.def 	}  instance HXT.XmlPickler ColourScheme where

@@ -55,7 +55,7 @@ --	range, 	opposites, -- * Functions---	reverseOrdering,+--	getOpposite, 	advanceDirection, 	attackDirectionsForPawn, 	listArrayByDirection,@@ -118,8 +118,8 @@  -- | Define a /direction/ by the sense of change to /x/ & /y/ coordinates. data Direction	= MkDirection {-	getXDirection	:: Ordering,	-- ^ The sense of the change in the /x/-coordinate.-	getYDirection	:: Ordering	-- ^ The sense of the change in the /y/-coordinate.+	getXDirection	:: ! Ordering,	-- ^ The sense of the change in the /x/-coordinate.+	getYDirection	:: ! Ordering	-- ^ The sense of the change in the /y/-coordinate. } deriving (Eq, Ord)  instance Bounded Direction where@@ -164,19 +164,13 @@ 		'E' : _	-> [(e, tail s')] 		_	-> []	-- No parse. --- | Get the opposite.-reverseOrdering :: Ordering -> Ordering-reverseOrdering LT	= GT-reverseOrdering GT	= LT-reverseOrdering _	= EQ- instance Property.Opposable.Opposable Direction where 	getOpposite MkDirection { 		getXDirection	= xDirection, 		getYDirection	= yDirection 	} = MkDirection {-		getXDirection	= reverseOrdering xDirection,-		getYDirection	= reverseOrdering yDirection+		getXDirection	= Property.Opposable.getOpposite xDirection,+		getYDirection	= Property.Opposable.getOpposite yDirection 	}  instance Property.Orientated.Orientated Direction where@@ -186,12 +180,12 @@  instance Property.Reflectable.ReflectableOnX Direction where 	reflectOnX direction@MkDirection { getYDirection = yDirection }	= direction {-		getYDirection	= reverseOrdering yDirection+		getYDirection	= Property.Opposable.getOpposite yDirection 	}  instance Property.Reflectable.ReflectableOnY Direction where 	reflectOnY direction@MkDirection { getXDirection = xDirection }	= direction {-		getXDirection	= reverseOrdering xDirection+		getXDirection	= Property.Opposable.getOpposite xDirection 	}  instance HXT.XmlPickler Direction where

@@ -49,6 +49,7 @@ 	isCapture, 	isPromotion, 	isQuiet,+	isSimple, 	isAcyclic, -- ** Query 	getMaybeExplicitlyTakenRank,@@ -232,6 +233,14 @@ 	getMaybePromotionRank	= Nothing }			= True isQuiet	moveType	= isCastle moveType++-- | The simplest type of move.+isSimple :: MoveType -> Bool+isSimple Normal {+	getMaybeTakenRank	= Nothing,+	getMaybePromotionRank	= Nothing+}		= True+isSimple _	= False	-- Neither Castling nor En-passant qualifies.  {- | 	* Whether the /move/ can't be a member of a repeated cycle.

@@ -29,11 +29,10 @@  module BishBosh.Attribute.PhysicalColour( -- * Types--- ** Type-synonyms---	ANSIColourCode, -- ** Data-types-	PhysicalColour(..),+	PhysicalColour(), -- * Constants+--	range, 	black, 	red, 	green,@@ -41,22 +40,20 @@ 	blue, 	magenta, 	cyan,-	white,---	range,--- * Functions---	toANSIColourCode,-	mkFgColourCode,-	mkBgColourCode,-	selectGraphicsRendition,-	bracket+	white ) where  import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable import qualified	Control.DeepSeq import qualified	Text.XML.HXT.Arrow.Pickle		as HXT import qualified	Text.XML.HXT.Arrow.Pickle.Schema --- | Defines the sum-type of physical colours which can typically be rendered by a terminal.+{- |+	* Defines the sum-type of physical colours which can typically be rendered by a terminal.++	* CAVEAT: the constructor-order both facilitates conversion to an ANSI Colour-code & the derivation of the complementary colour.+-} data PhysicalColour 	= Black 	| Red@@ -78,6 +75,9 @@ instance HXT.XmlPickler PhysicalColour where 	xpickle	= HXT.xpWrap (read, show) . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range +instance Property.Opposable.Opposable PhysicalColour where+	getOpposite physicalColour	= toEnum $ fromEnum (maxBound :: PhysicalColour) - fromEnum physicalColour	-- N.B. the complementary colour+ -- | The constant complete range of values. range :: [PhysicalColour] range	= [minBound .. maxBound]@@ -116,29 +116,4 @@ -- | Constant. white :: PhysicalColour white	= White---- | A colour-code, as used by terminal-emulators; <https://en.wikipedia.org/wiki/ANSI_escape_code>.-type ANSIColourCode	= Int---- | Offset the specified colour-code, so that it applies to the foreground.-mkFgColourCode :: PhysicalColour -> ANSIColourCode-mkFgColourCode	= (+ 30) . toANSIColourCode---- | Offset the specified colour-code, so that it applies to the background.-mkBgColourCode :: PhysicalColour -> ANSIColourCode-mkBgColourCode	= (+ 40) . toANSIColourCode---- | Translate.-toANSIColourCode :: PhysicalColour -> ANSIColourCode-toANSIColourCode	= fromEnum	-- CAVEAT: the order of the data-constructors has been defined with this in mind.---- | Generate the escape-sequence required to change a terminal to the specified physical colour.-selectGraphicsRendition :: Bool -> ANSIColourCode -> String-selectGraphicsRendition isBold parameter	= showString "\x1b[" . shows parameter $ (if isBold then showString ";1" else id) "m"---- | Render the specified string according to instructions, then revert to default.-bracket :: String -> String -> ShowS-bracket graphicsRendition s	= showString graphicsRendition . showString s . showString (-	selectGraphicsRendition False 0- ) 

@@ -49,7 +49,7 @@ 	earthBound, 	expendable, 	nDistinctRanks,---	allocationPerSide,+	initialAllocationByRankPerSide, -- * Functions 	compareByLVA, 	findUndefinedRanks,@@ -202,9 +202,9 @@ nDistinctRanks :: Type.Count.NRanks nDistinctRanks	= fromIntegral $ length range --- | The number of each rank allocated to each side.-allocationPerSide :: ArrayByRank Type.Count.NRanks-allocationPerSide	= listArrayByRank [8, 2, 2, 2, 1, 1]+-- | The constant number of each rank per side, at the conventional opening position.+initialAllocationByRankPerSide :: ArrayByRank Type.Count.NPieces+initialAllocationByRankPerSide	= listArrayByRank [8, 2, 2, 2, 1, 1]  -- | A boxed array indexed by /rank/, of arbitrary values. type ArrayByRank	= Data.Array.IArray.Array Rank

@@ -29,15 +29,15 @@ -}  module BishBosh.Cartesian.Abscissa(--- * Types-	ArrayByAbscissa, -- * Constants-	xOrigin, 	xLength, 	xMin, 	xMax, 	xBounds, 	xRange,+	bishopsFiles,+	kingsFile,+--	adjacents, -- * Functions 	toIx, 	fromIx,@@ -45,68 +45,66 @@ 	translate, 	maybeTranslate, 	getAdjacents,+--	getAdjacents', -- ** Constructors 	listArrayByAbscissa, -- ** Predicates 	inBounds ) where -import qualified	BishBosh.Data.Enum	as Data.Enum+import			Data.Array.IArray((!)) import qualified	BishBosh.Type.Length	as Type.Length import qualified	Control.Exception import qualified	Data.Array.IArray --- | The position of the origin on the /x/-axis.-xOrigin :: Int-xOrigin	= 0- -- | The constant length of the /x/-axis.-xLength :: Type.Length.Distance+xLength :: Type.Length.X xLength	= 8 --- | The constant lower bound of abscissae.-xMin :: Enum x => x-xMin	= toEnum xOrigin---- | The constant upper bound of abscissae.-xMax :: Enum x => x-xMax	= toEnum $ xOrigin + fromIntegral (pred {-fence-post-} xLength)- -- | The constant bounds of abscissae.-xBounds :: Enum x => (x, x)-xBounds	= (xMin, xMax)+xBounds :: (Type.Length.X, Type.Length.X)+xMin, xMax :: Type.Length.X+xBounds@(xMin, xMax)	= (0, xMin + pred {-fence-post-} xLength)  -- | The constant list of all abscissae.-xRange :: Enum x => [x]+xRange :: [Type.Length.X] xRange	= uncurry enumFromTo xBounds +-- | The conventional starting /file/s for the @Bishops@ of either /logical colour/.+bishopsFiles :: [Type.Length.X]+bishopsFiles	= map fromIx [2, 5]++-- | The conventional starting /file/ for the @King@ of either /logical colour/.+kingsFile :: Type.Length.X+kingsFile	= fromIx 4+ -- | Convert to an array-index.-toIx :: Enum x => x -> Int+toIx :: Type.Length.X -> Int {-# INLINE toIx #-}-toIx	= subtract xOrigin . fromEnum+toIx	= fromIntegral . subtract xMin  -- | Convert from an array-index.-fromIx :: Enum x => Int -> x+fromIx :: Int -> Type.Length.X {-# INLINE fromIx #-}-fromIx	= toEnum . (+ xOrigin)+fromIx	= (+ xMin) . fromIntegral  -- | Reflects about the mid-point of the axis.-reflect :: Enum x => x -> x-reflect	= Data.Enum.translate $ (-	+ (2 * xOrigin + fromIntegral (pred xLength))+reflect :: Type.Length.X -> Type.Length.X+reflect	= (+	+ (2 * xMin + pred xLength)  ) . negate  -- | Predicate.-inBounds :: (Enum x, Ord x) => x -> Bool+inBounds :: Type.Length.X -> Bool {-# INLINE inBounds #-} inBounds x	= x >= xMin && x <= xMax  -- | Translate the specified ordinate.-translate :: (Enum x, Ord x) => (x -> x) -> x -> x+translate :: (Type.Length.X -> Type.Length.X) -> Type.Length.X -> Type.Length.X translate transformation	= (\x -> Control.Exception.assert (inBounds x) x) . transformation  -- | Where legal, translate the specified abscissa.-maybeTranslate :: (Enum x, Ord x) => (x -> x) -> x -> Maybe x+maybeTranslate :: (Type.Length.X -> Type.Length.X) -> Type.Length.X -> Maybe Type.Length.X maybeTranslate transformation	= ( 	\x -> if inBounds x 		then Just x@@ -114,21 +112,21 @@  ) . transformation  -- | Get the abscissae immediately left & right.-getAdjacents :: (Enum x, Eq x) => x -> [x]-{-# INLINE getAdjacents #-}-getAdjacents x+getAdjacents' :: Type.Length.X -> [Type.Length.X]+getAdjacents' x 	| x == xMin	= [succ xMin] 	| x == xMax	= [pred xMax] 	| otherwise	= [pred x, succ x] --- | A boxed array indexed by /coordinates/, of arbitrary elements.-type ArrayByAbscissa x	= Data.Array.IArray.Array {-Boxed-} x+-- | The constant abscissae either side of each value.+adjacents :: Data.Array.IArray.Array Type.Length.X [Type.Length.X]+adjacents	= listArrayByAbscissa $ map getAdjacents' xRange +-- | Get the abscissae immediately left & right.+getAdjacents :: Type.Length.X -> [Type.Length.X]+getAdjacents	= (adjacents !)+ -- | Array-constructor.-listArrayByAbscissa :: (-	Data.Array.IArray.IArray	a e,-	Data.Array.IArray.Ix		x,-	Enum				x- ) => [e] -> a x e+listArrayByAbscissa :: Data.Array.IArray.IArray a e => [e] -> a Type.Length.X e listArrayByAbscissa	= Data.Array.IArray.listArray xBounds 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts #-}+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -45,9 +45,7 @@ -- * Functions --	extrapolate', 	extrapolate,---	extrapolateInt, 	interpolate,---	interpolateInt, 	getLogicalColourOfSquare, 	kingsStartingCoordinates, 	rooksStartingCoordinates,@@ -79,7 +77,7 @@ 	areSquaresIsochromatic ) where -import			Control.Arrow((&&&))+import			Control.Arrow((&&&), (***)) import			Data.Array.IArray((!)) import qualified	BishBosh.Attribute.Direction			as Attribute.Direction import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour@@ -92,13 +90,15 @@ import qualified	BishBosh.Property.Reflectable			as Property.Reflectable import qualified	BishBosh.Property.Rotatable			as Property.Rotatable import qualified	BishBosh.Text.ShowList				as Text.ShowList+import qualified	BishBosh.Type.Count				as Type.Count import qualified	BishBosh.Type.Length				as Type.Length import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.Array.IArray import qualified	Data.Array.Unboxed+import qualified	Data.Foldable import qualified	Data.List-import qualified	Data.Map+import qualified	Data.Map					as Map import qualified	Data.Maybe  #ifdef USE_PARALLEL@@ -110,39 +110,28 @@ tag	= "coordinates"  -- | The /coordinates/ of a square on the board.-data Coordinates x y	= MkCoordinates {-	getX	:: x,	-- ^ Abscissa.-	getY	:: y	-- ^ Ordinate.+data Coordinates	= MkCoordinates {+	getX	:: ! Type.Length.X,	-- ^ Abscissa.+	getY	:: ! Type.Length.Y	-- ^ Ordinate. } deriving Eq -instance (-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y- ) => Control.DeepSeq.NFData (Coordinates x y) where+instance Control.DeepSeq.NFData Coordinates where 	rnf MkCoordinates { getX = x, getY = y }	= Control.DeepSeq.rnf (x, y) -instance (Show x, Show y) => Show (Coordinates x y) where+instance Show Coordinates where 	showsPrec precedence MkCoordinates { getX = x, getY = y }	= showsPrec precedence (x, y) -instance (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Read	x,-	Read	y- ) => Read (Coordinates x y) where+instance Read Coordinates where 	readsPrec precedence s	= [ 		(coordinates, remainder) | 			((x, y), remainder)	<- readsPrec precedence s, 			coordinates		<- Data.Maybe.maybeToList $ mkMaybeCoordinates x y 	 ] -- List-comprehension. -instance (Ord x, Ord y) => Ord (Coordinates x y) where-	{-# SPECIALISE instance Ord (Coordinates Type.Length.X Type.Length.Y) #-}+instance Ord Coordinates where 	MkCoordinates { getX = x, getY = y } `compare` MkCoordinates { getX = x', getY = y' }	= (y, x) `compare` (y', x')	-- N.B.: x is less significant than y, as required by the implementation of 'Data.Array.IArray.Ix.inRange'. -instance (Enum x, Enum y) => Bounded (Coordinates x y) where+instance Bounded Coordinates where 	minBound = MkCoordinates { 		getX	= Cartesian.Abscissa.xMin, 		getY	= Cartesian.Ordinate.yMin@@ -152,48 +141,41 @@ 		getY	= Cartesian.Ordinate.yMax 	} -- Top Right. -instance (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- ) => Data.Array.IArray.Ix (Coordinates x y) where-	{-# SPECIALISE instance Data.Array.IArray.Ix (Coordinates Type.Length.X Type.Length.Y) #-}+instance Data.Array.IArray.Ix Coordinates where 	range (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) Property.FixedMembership.members 	inRange (lower, upper) coordinates	= Control.Exception.assert (coordinates >= lower && coordinates <= upper) True 	index (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) . toIx -instance Enum y => Property.Reflectable.ReflectableOnX (Coordinates x y) where+instance Property.Reflectable.ReflectableOnX Coordinates where 	reflectOnX coordinates@MkCoordinates { getY = y }	= coordinates { getY = Cartesian.Ordinate.reflect y } -instance Enum x => Property.Reflectable.ReflectableOnY (Coordinates x y) where+instance Property.Reflectable.ReflectableOnY Coordinates where 	reflectOnY coordinates@MkCoordinates { getX = x }	= coordinates { getX = Cartesian.Abscissa.reflect x } -instance (Enum x, Enum y) => Property.Rotatable.Rotatable (Coordinates x y) where+instance Property.Rotatable.Rotatable Coordinates where 	rotate90	= rotate Attribute.Direction.w 	rotate180	= rotate Attribute.Direction.s 	rotate270	= rotate Attribute.Direction.e  -- | Constant.-topLeft :: (Enum x, Enum y) => Coordinates x y+topLeft :: Coordinates topLeft = MkCoordinates { 	getX	= Cartesian.Abscissa.xMin, 	getY	= Cartesian.Ordinate.yMax }  -- | Constant.-bottomRight :: (Enum x, Enum y) => Coordinates x y+bottomRight :: Coordinates bottomRight = MkCoordinates { 	getX	= Cartesian.Abscissa.xMax, 	getY	= Cartesian.Ordinate.yMin }  -- | The constant number of squares on the board.-nSquares :: Int-nSquares	= fromIntegral $ Cartesian.Abscissa.xLength * Cartesian.Ordinate.yLength+nSquares :: Type.Count.NCoordinates+nSquares	= fromIntegral Cartesian.Abscissa.xLength * fromIntegral Cartesian.Ordinate.yLength -instance (Enum x, Enum y) => Property.FixedMembership.FixedMembership (Coordinates x y) where-	{-# SPECIALISE instance Property.FixedMembership.FixedMembership (Coordinates Type.Length.X Type.Length.Y) #-}+instance Property.FixedMembership.FixedMembership Coordinates where 	members	= [ 		MkCoordinates { 			getX	= x,@@ -204,47 +186,30 @@ 	 ] -- List-comprehension.  -- | Predicate.-inBounds :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> x	-- ^ Abscissa.-	-> y	-- ^ Ordinate.+inBounds+	:: Type.Length.X	-- ^ Abscissa.+	-> Type.Length.Y	-- ^ Ordinate. 	-> Bool-{-# INLINABLE inBounds #-} inBounds x y	= Cartesian.Abscissa.inBounds x && Cartesian.Ordinate.inBounds y  -- | Constructor.-mkCoordinates :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> x	-- ^ Abscissa.-	-> y	-- ^ Ordinate.-	-> Coordinates x y+mkCoordinates+	:: Type.Length.X	-- ^ Abscissa.+	-> Type.Length.Y	-- ^ Ordinate.+	-> Coordinates mkCoordinates x y	= Control.Exception.assert (inBounds x y) $ MkCoordinates x y  -- | Safe constructor.-mkMaybeCoordinates :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> x	-- ^ Abscissa.-	-> y	-- ^ Ordinate.-	-> Maybe (Coordinates x y)+mkMaybeCoordinates+	:: Type.Length.X	-- ^ Abscissa.+	-> Type.Length.Y	-- ^ Ordinate.+	-> Maybe Coordinates mkMaybeCoordinates x y 	| inBounds x y	= Just MkCoordinates { getX = x, getY = y } 	| otherwise	= Nothing  -- | Convert to an array-index.-toIx :: (Enum x, Enum y) => Coordinates x y -> Int-{-# SPECIALISE toIx :: Coordinates Type.Length.X Type.Length.Y -> Int #-}+toIx :: Coordinates -> Int toIx MkCoordinates { 	getX	= x, 	getY	= y@@ -255,7 +220,7 @@  	* CAVEAT: assumes that the array is indexed by the whole range of /coordinates/. -}-fromIx :: (Enum x, Enum y) => Int -> Coordinates x y+fromIx :: Int -> Coordinates fromIx	= ( 	\(y, x) -> MkCoordinates { 		getX	= Cartesian.Abscissa.fromIx x,@@ -268,28 +233,14 @@  	* CAVEAT: the caller must ensure that the results are legal. -}-translate :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- ) => ((x, y) -> (x, y)) -> Coordinates x y -> Coordinates x y+translate :: ((Type.Length.X, Type.Length.Y) -> (Type.Length.X, Type.Length.Y)) -> Coordinates -> Coordinates translate transformation MkCoordinates { 	getX	= x, 	getY	= y } = uncurry mkCoordinates $ transformation (x, y)  -- | Where legal, translate the specified /coordinates/.-maybeTranslate :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> ((x, y) -> (x, y))	-- ^ Translation.-	-> Coordinates x y-	-> Maybe (Coordinates x y)-{-# INLINABLE maybeTranslate #-}+maybeTranslate :: ((Type.Length.X, Type.Length.Y) -> (Type.Length.X, Type.Length.Y)) -> Coordinates -> Maybe Coordinates maybeTranslate transformation MkCoordinates { 	getX	= x, 	getY	= y@@ -300,15 +251,14 @@  	* CAVEAT: the caller must ensure that the results are legal. -}-translateX :: (Enum x, Ord x) => (x -> x) -> Transformation x y+translateX :: (Type.Length.X -> Type.Length.X) -> Transformation translateX transformation coordinates@MkCoordinates { getX = x }	= coordinates { getX = Cartesian.Abscissa.translate transformation x }  -- | Where legal, translate the /x/-component of the specified /coordinates/. maybeTranslateX-	:: (Enum x, Ord x)-	=> (x -> x)	-- ^ Translation.-	-> Coordinates x y-	-> Maybe (Coordinates x y)+	:: (Type.Length.X -> Type.Length.X)	-- ^ Translation.+	-> Coordinates+	-> Maybe Coordinates maybeTranslateX transformation coordinates@MkCoordinates { getX = x }	= (\x' -> coordinates { getX = x' }) `fmap` Cartesian.Abscissa.maybeTranslate transformation x  {- |@@ -316,15 +266,14 @@  	* CAVEAT: the caller must ensure that the results are legal. -}-translateY :: (Enum y, Ord y) => (y -> y) -> Transformation x y+translateY :: (Type.Length.Y -> Type.Length.Y) -> Transformation translateY transformation coordinates@MkCoordinates { getY = y }	= coordinates { getY = Cartesian.Ordinate.translate transformation y }  -- | Where legal, translate the /y/-component of the specified /coordinates/. maybeTranslateY-	:: (Enum y, Ord y)-	=> (y -> y)	-- ^ Translation.-	-> Coordinates x y-	-> Maybe (Coordinates x y)+	:: (Type.Length.Y -> Type.Length.Y)	-- ^ Translation.+	-> Coordinates+	-> Maybe Coordinates maybeTranslateY transformation coordinates@MkCoordinates { getY = y }	= (\y' -> coordinates { getY = y' }) `fmap` Cartesian.Ordinate.maybeTranslate transformation y  {- |@@ -332,14 +281,7 @@  	* CAVEAT: the caller must ensure that the results are legal. -}-mkRelativeCoordinates :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> ((x, y) -> (x, y))	-- ^ Translation.-	-> Coordinates x y+mkRelativeCoordinates :: ((Type.Length.X, Type.Length.Y) -> (Type.Length.X, Type.Length.Y)) -> Coordinates mkRelativeCoordinates	= (`translate` minBound)  {- |@@ -348,20 +290,17 @@ 	* CAVEAT: the caller must ensure that the results are legal. -} advance-	:: (Enum y, Ord	y)-	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.-	-> Transformation x y-{-# INLINE advance #-}+	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.+	-> Transformation advance logicalColour	= translateY $ if Attribute.LogicalColour.isBlack logicalColour 	then pred 	else succ  -- | Where legal, move one step towards the opponent. maybeAdvance-	:: (Enum y, Ord	y)-	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.-	-> Coordinates x y				-- ^ The location from which to advanced.-	-> Maybe (Coordinates x y)+	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.+	-> Coordinates				-- ^ The location from which to advanced.+	-> Maybe Coordinates maybeAdvance logicalColour	= maybeTranslateY $ if Attribute.LogicalColour.isBlack logicalColour 	then pred 	else succ@@ -372,29 +311,26 @@ 	* CAVEAT: the caller must ensure that the results are legal. -} retreat-	:: (Enum y, Ord	y)-	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.-	-> Transformation x y+	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.+	-> Transformation retreat	= advance . Property.Opposable.getOpposite  -- | Where legal, move one step away from the opponent. maybeRetreat-	:: (Enum y, Ord y)-	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.-	-> Coordinates x y				-- ^ The location from which to retreat.-	-> Maybe (Coordinates x y)+	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.+	-> Coordinates				-- ^ The location from which to retreat.+	-> Maybe Coordinates maybeRetreat	= maybeAdvance . Property.Opposable.getOpposite  -- | Get the /coordinates/ immediately left & right.-getAdjacents :: (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]+getAdjacents :: Coordinates -> [Coordinates] getAdjacents coordinates@MkCoordinates { getX = x }	= map (\x' -> coordinates { getX = x' }) $ Cartesian.Abscissa.getAdjacents x  -- | Generates a line of /coordinates/, starting just after the specified source & proceeding in the specified /direction/ to the edge of the board. extrapolate'-	:: (Enum x, Enum y)-	=> Attribute.Direction.Direction	-- ^ The direction in which to proceed.-	-> Coordinates x y			-- ^ The point from which to start.-	-> [Coordinates x y]+	:: Attribute.Direction.Direction	-- ^ The direction in which to proceed.+	-> Coordinates			-- ^ The point from which to start.+	-> [Coordinates] extrapolate' direction MkCoordinates { 	getX	= x, 	getY	= y@@ -417,30 +353,13 @@ 	In consequence, it is typically automatically avoided using a rewrite-rule to lookup an array of the results from all possible calls. -} extrapolate-	:: (Enum x, Enum y)-	=> Attribute.Direction.Direction	-- ^ The direction in which to proceed.-	-> Coordinates x y			-- ^ The point from which to start.-	-> [Coordinates x y]-{-# NOINLINE extrapolate #-}	-- Ensure the rewrite-rule triggers.-{-# RULES "extrapolate/Int" extrapolate = extrapolateInt #-}	-- CAVEAT: the call-stack leading here must be specialised to ensure this rule triggers.-extrapolate	= extrapolate'---- | A specialisation of 'extrapolate'.-extrapolateInt :: Attribute.Direction.Direction -> Coordinates Type.Length.X Type.Length.Y -> [Coordinates Type.Length.X Type.Length.Y]-extrapolateInt direction coordinates	= extrapolationsByDirectionByCoordinates ! coordinates ! direction+	:: Attribute.Direction.Direction	-- ^ The direction in which to proceed.+	-> Coordinates			-- ^ The point from which to start.+	-> [Coordinates]+extrapolate direction coordinates	= extrapolationsByDirectionByCoordinates ! coordinates ! direction  -- | The constant lists of /coordinates/, extrapolated from every /coordinate/ in the /board/, in every /direction/.-extrapolationsByDirectionByCoordinates :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y,-#endif-	Enum			x,-	Enum			y,-	Ord			x,-	Ord			y- ) => ArrayByCoordinates x y (Attribute.Direction.ArrayByDirection [Coordinates x y])-{-# SPECIALISE extrapolationsByDirectionByCoordinates :: ArrayByCoordinates Type.Length.X Type.Length.Y (Attribute.Direction.ArrayByDirection [Coordinates Type.Length.X Type.Length.Y]) #-}	-- To promote memoisation.+extrapolationsByDirectionByCoordinates :: ArrayByCoordinates (Attribute.Direction.ArrayByDirection [Coordinates]) extrapolationsByDirectionByCoordinates	= listArrayByCoordinates #ifdef USE_PARALLEL 	. Control.Parallel.Strategies.withStrategy (Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq)@@ -450,23 +369,13 @@ 	) Property.FixedMembership.members  -- | The list of /coordinates/, between every permutation of source & valid destination on the /board/.-interpolationsByDestinationBySource :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y,-#endif-	Enum			x,-	Enum			y,-	Ord			x,-	Ord			y- ) => ArrayByCoordinates x y (Data.Map.Map (Coordinates x y) [Coordinates x y])-{-# SPECIALISE interpolationsByDestinationBySource :: ArrayByCoordinates Type.Length.X Type.Length.Y (Data.Map.Map (Coordinates Type.Length.X Type.Length.Y) [Coordinates Type.Length.X Type.Length.Y]) #-}	-- To promote memoisation.+interpolationsByDestinationBySource :: ArrayByCoordinates (Map.Map Coordinates [Coordinates]) interpolationsByDestinationBySource	= Data.Array.IArray.amap (-	Data.Map.fromList . map (+	Map.fromList . map ( 		last {-destination-} &&& id {-interpolation-} 	) . concatMap ( 		tail {-remove null list-} . Data.List.inits	-- Generate all possible interpolations from this extrapolation.-	) . Data.Array.IArray.elems+	) . Data.Foldable.toList  ) extrapolationsByDirectionByCoordinates	-- Derive from extrapolations.  {- |@@ -474,77 +383,41 @@  	* CAVEAT: the destination-/coordinates/ must be a valid @Queen@'s /move/ from the source; so that all intermediate points lie on a square of the board. -}-interpolate :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> Coordinates x y	-- ^ Source.-	-> Coordinates x y	-- ^ Destination.-	-> [Coordinates x y]-{-# NOINLINE interpolate #-}	-- Ensure the rewrite-rule triggers.-{-# RULES "interpolate/Int" interpolate = interpolateInt #-}	-- CAVEAT: the call-stack leading here must be specialised to ensure this rule triggers.-interpolate source@MkCoordinates {-	getX	= x,-	getY	= y-} destination@MkCoordinates {-	getX	= x',-	getY	= y'-}-	| source == destination	= []	-- CAVEAT: an invalid move.-	| otherwise		= Control.Exception.assert (-		x == x' || y == y' || (-			let-				distanceX, distanceY :: Type.Length.Distance-				(distanceX, distanceY)	= measureDistance source destination-			in abs distanceX == abs distanceY-		) -- Check that the move is straight.-	) $ zipWith MkCoordinates (x `spanInterval` x') (y `spanInterval` y')-	where-		spanInterval :: (Enum a, Ord a) => a -> a -> [a]-		spanInterval fromAfter to	= case to `compare` fromAfter of-			GT	-> [succ fromAfter .. to]-			LT	-> let startFromAfter = pred fromAfter in startFromAfter `seq` [startFromAfter, pred startFromAfter .. to]-			EQ	-> repeat fromAfter---- | A specialisation of 'interpolate'.-interpolateInt :: Coordinates Type.Length.X Type.Length.Y -> Coordinates Type.Length.X Type.Length.Y -> [Coordinates Type.Length.X Type.Length.Y]-interpolateInt coordinatesSource coordinatesDestination	= interpolationsByDestinationBySource ! coordinatesSource Data.Map.! coordinatesDestination+interpolate :: Coordinates -> Coordinates -> [Coordinates]+interpolate coordinatesSource coordinatesDestination	= interpolationsByDestinationBySource ! coordinatesSource Map.! coordinatesDestination  -- | The type of a function which changes one set of /coordinates/ to another.-type Transformation x y	= Coordinates x y -> Coordinates x y+type Transformation	= Coordinates -> Coordinates  {- | 	* Rotates the specified /coordinates/, so that the @Black@ pieces start on the specified side of the board; a /direction/ of @N@ involves no change.  	* CAVEAT: one can only request an integral multiple of 90 degrees. -}-rotate :: (Enum x, Enum y) => Attribute.Direction.Direction -> Transformation x y+rotate :: Attribute.Direction.Direction -> Transformation rotate direction coordinates@MkCoordinates { 	getX	= x, 	getY	= y } = case Attribute.Direction.getXDirection &&& Attribute.Direction.getYDirection $ direction of 	(EQ, GT)	-> coordinates 	(LT, EQ)	-> MkCoordinates {-		getX	= Cartesian.Abscissa.fromIx $ fromIntegral yDistance',-		getY	= Cartesian.Ordinate.fromIx $ fromIntegral xDistance+		getX	= Cartesian.Abscissa.fromIx yDistance',+		getY	= Cartesian.Ordinate.fromIx xDistance 	} -- +90 degrees, i.e. anti-clockwise. 	(EQ, LT)	-> MkCoordinates {-		getX	= Cartesian.Abscissa.fromIx $ fromIntegral xDistance',-		getY	= Cartesian.Ordinate.fromIx $ fromIntegral yDistance'+		getX	= Cartesian.Abscissa.fromIx xDistance',+		getY	= Cartesian.Ordinate.fromIx yDistance' 	} -- 180 degrees. 	(GT, EQ)	-> MkCoordinates {-		getX	= Cartesian.Abscissa.fromIx $ fromIntegral yDistance,-		getY	= Cartesian.Ordinate.fromIx $ fromIntegral xDistance'+		getX	= Cartesian.Abscissa.fromIx yDistance,+		getY	= Cartesian.Ordinate.fromIx xDistance' 	} -- -90 degrees, i.e. clockwise. 	_		-> Control.Exception.throw . Data.Exception.mkRequestFailure . showString "BishBosh.Cartesian.Coordinates.rotate:\tunable to rotate to direction" . Text.ShowList.showsAssociation $ shows direction "." 	where-		xDistance, xDistance', yDistance, yDistance'	:: Type.Length.Distance-		xDistance	= fromIntegral $ Cartesian.Abscissa.toIx x-		yDistance	= fromIntegral $ Cartesian.Ordinate.toIx y-		xDistance'	= pred Cartesian.Abscissa.xLength - xDistance-		yDistance'	= pred Cartesian.Ordinate.yLength - yDistance+		xDistance	= Cartesian.Abscissa.toIx x+		yDistance	= Cartesian.Ordinate.toIx y+		xDistance'	= fromIntegral (pred Cartesian.Abscissa.xLength) - xDistance+		yDistance'	= fromIntegral (pred Cartesian.Ordinate.yLength) - yDistance  {- | 	* Measures the signed distance between source & destination /coordinates/.@@ -553,88 +426,61 @@  	* CAVEAT: beware the potential fence-post error. -}-measureDistance :: (-	Enum	x,-	Enum	y,-	Num	distance- )-	=> Coordinates x y	-- ^ Source.-	-> Coordinates x y	-- ^ Destination.-	-> (distance, distance)	-- ^ (X-distance, Y-distance)-{-# INLINE measureDistance #-}+measureDistance+	:: Coordinates	-- ^ Source.+	-> Coordinates	-- ^ Destination.+	-> (Type.Length.X, Type.Length.Y) measureDistance MkCoordinates { 	getX	= x, 	getY	= y } MkCoordinates { 	getX	= x', 	getY	= y'-} = (fromIntegral $ fromEnum x' - fromEnum x, fromIntegral $ fromEnum y' - fromEnum y)+} = (x' - x, y' - y)  -- | The /logical colour/ of the specified square.-getLogicalColourOfSquare :: (Enum x, Enum y) => Coordinates x y -> Attribute.LogicalColourOfSquare.LogicalColourOfSquare+getLogicalColourOfSquare :: Coordinates -> Attribute.LogicalColourOfSquare.LogicalColourOfSquare getLogicalColourOfSquare coordinates-	| even $ uncurry (+) distance	= Attribute.LogicalColourOfSquare.black-	| otherwise			= Attribute.LogicalColourOfSquare.white-	where-		distance :: (Type.Length.Distance, Type.Length.Distance)-		distance	= measureDistance minBound coordinates+	| uncurry (==) . (+		even *** even+	) $ measureDistance minBound coordinates	= Attribute.LogicalColourOfSquare.black+	| otherwise					= Attribute.LogicalColourOfSquare.white  -- | Whether the specified squares have the same /logical colour/.-areSquaresIsochromatic :: (Enum x, Enum y) => [Coordinates x y] -> Bool+areSquaresIsochromatic :: [Coordinates] -> Bool areSquaresIsochromatic	= uncurry (||) . (all (== minBound) &&& all (== maxBound)) . map getLogicalColourOfSquare  -- | The conventional starting /coordinates/ for the @King@ of the specified /logical colour/.-kingsStartingCoordinates :: (Enum x, Enum y) => Attribute.LogicalColour.LogicalColour -> Coordinates x y+kingsStartingCoordinates :: Attribute.LogicalColour.LogicalColour -> Coordinates kingsStartingCoordinates logicalColour	= MkCoordinates {-	getX	= Cartesian.Abscissa.fromIx 4,+	getX	= Cartesian.Abscissa.kingsFile, 	getY	= Cartesian.Ordinate.firstRank logicalColour }  -- | The conventional starting /coordinates/ for each @Rook@.-rooksStartingCoordinates :: (Enum x, Enum y) => Attribute.LogicalColour.LogicalColour -> [Coordinates x y]+rooksStartingCoordinates :: Attribute.LogicalColour.LogicalColour -> [Coordinates] rooksStartingCoordinates Attribute.LogicalColour.Black	= [topLeft, maxBound] rooksStartingCoordinates _				= [minBound, bottomRight]  -- | Whether the specified /coordinates/ are where a @Pawn@ of the specified /logical colour/ starts.-isPawnsFirstRank-	:: (Enum y, Eq y)-	=> Attribute.LogicalColour.LogicalColour-	-> Coordinates x y-	-> Bool-{-# INLINE isPawnsFirstRank #-}+isPawnsFirstRank :: Attribute.LogicalColour.LogicalColour -> Coordinates -> Bool isPawnsFirstRank logicalColour MkCoordinates { getY = y }	= y == Cartesian.Ordinate.pawnsFirstRank logicalColour  -- | Whether a @Pawn@ is currently on the appropriate /rank/ to take an opponent's @Pawn@ /en-passant/.-isEnPassantRank-	:: (Enum y, Eq y)-	=> Attribute.LogicalColour.LogicalColour-	-> Coordinates x y-	-> Bool+isEnPassantRank :: Attribute.LogicalColour.LogicalColour -> Coordinates -> Bool isEnPassantRank logicalColour MkCoordinates { getY = y }	= y == Cartesian.Ordinate.enPassantRank logicalColour  -- | A boxed array indexed by /coordinates/, of arbitrary elements.-type ArrayByCoordinates x y	= Data.Array.IArray.Array (Coordinates x y)+type ArrayByCoordinates	= Data.Array.IArray.Array Coordinates  -- | An unboxed array indexed by /coordinates/, of fixed-size elements.-type UArrayByCoordinates x y	= Data.Array.Unboxed.UArray (Coordinates x y)+type UArrayByCoordinates	= Data.Array.Unboxed.UArray Coordinates  -- | Array-constructor from an ordered list of elements.-listArrayByCoordinates :: (-	Data.Array.IArray.IArray	a e,-	Enum				x,-	Enum				y,-	Ord				x,-	Ord				y- ) => [e] -> a (Coordinates x y) e+listArrayByCoordinates :: Data.Array.IArray.IArray a e => [e] -> a Coordinates e listArrayByCoordinates	= Data.Array.IArray.listArray (minBound, maxBound)  -- | Array-constructor from an association-list.-arrayByCoordinates :: (-	Data.Array.IArray.IArray	a e,-	Enum				x,-	Enum				y,-	Ord				x,-	Ord				y- ) => [(Coordinates x y, e)] -> a (Coordinates x y) e+arrayByCoordinates :: Data.Array.IArray.IArray a e => [(Coordinates, e)] -> a Coordinates e arrayByCoordinates	= Data.Array.IArray.array (minBound, maxBound) 

@@ -29,10 +29,7 @@ -}  module BishBosh.Cartesian.Ordinate(--- * Types---	ArrayByOrdinate, -- * Constants-	yOrigin, 	yLength, 	yMin, 	yMax,@@ -48,107 +45,80 @@ 	reflect, 	translate, 	maybeTranslate,--- ** Constructors---	listArrayByOrdinate, -- ** Predicates 	inBounds ) where  import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa-import qualified	BishBosh.Data.Enum			as Data.Enum import qualified	BishBosh.Property.Opposable		as Property.Opposable import qualified	BishBosh.Type.Length			as Type.Length import qualified	Control.Exception-import qualified	Data.Array.IArray --- | The position of the origin on the /y/-axis.-yOrigin :: Int-yOrigin	= Cartesian.Abscissa.xOrigin	-- N.B. it doesn't need to be the same.- -- | The constant length of the /y/-axis.-yLength :: Type.Length.Distance-yLength	= Cartesian.Abscissa.xLength	-- Because the board is square.---- | The constant lower bound of ordinates.-yMin :: Enum y => y-yMin	= toEnum yOrigin---- | The constant upper bound of ordinates.-yMax :: Enum y => y-yMax	= toEnum $ yOrigin + fromIntegral (pred {-fence-post-} yLength)+yLength :: Type.Length.Y+yLength	= fromIntegral Cartesian.Abscissa.xLength	-- I.E.: the board is square.  -- | The constant bounds of ordinates.-yBounds :: Enum y => (y, y)-yBounds	= (yMin, yMax)+yBounds :: (Type.Length.Y, Type.Length.Y)+yMin, yMax :: Type.Length.Y+yBounds@(yMin, yMax)	= (0, yMin + pred {-fence-post-} yLength)  -- | The constant list of all ordinates.-yRange :: Enum y => [y]+yRange :: [Type.Length.Y] yRange	= uncurry enumFromTo yBounds  -- | Convert to an array-index.-toIx :: Enum y => y -> Int+toIx :: Type.Length.Y -> Int {-# INLINE toIx #-}-toIx	= subtract yOrigin . fromEnum+toIx	= fromIntegral . subtract yMin  -- | Convert from an array-index.-fromIx :: Enum y => Int -> y+fromIx :: Int -> Type.Length.Y {-# INLINE fromIx #-}-fromIx	= toEnum . (+ yOrigin)+fromIx	= (+ yMin) . fromIntegral  -- | The /rank/ from which /piece/s conventionally start.-firstRank :: Enum y => Attribute.LogicalColour.LogicalColour -> y+firstRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y firstRank Attribute.LogicalColour.Black	= yMax firstRank _				= yMin  -- | The final /rank/; i.e. the one on which a @Pawn@ is promoted.-lastRank :: Enum y => Attribute.LogicalColour.LogicalColour -> y+lastRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y lastRank	= firstRank . Property.Opposable.getOpposite  -- | The /rank/ from which @Pawn@s conventionally start.-pawnsFirstRank :: Enum y => Attribute.LogicalColour.LogicalColour -> y+pawnsFirstRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y {-# INLINE pawnsFirstRank #-} pawnsFirstRank Attribute.LogicalColour.Black	= pred yMax pawnsFirstRank _				= succ yMin  -- | The /rank/ from which a @Pawn@ may capture /en-passant/.-enPassantRank :: Enum y => Attribute.LogicalColour.LogicalColour -> y+enPassantRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y {-# INLINE enPassantRank #-}-enPassantRank Attribute.LogicalColour.Black	= toEnum $ yOrigin + 3-enPassantRank _					= toEnum $ yOrigin + 4+enPassantRank Attribute.LogicalColour.Black	= fromIx 3+enPassantRank _					= fromIx 4  -- | Reflects about the mid-point of the axis.-reflect :: Enum y => y -> y-reflect	= Data.Enum.translate $ (-	+ (2 * yOrigin + fromIntegral (pred yLength))+reflect :: Type.Length.Y -> Type.Length.Y+reflect	= (+	+ (2 * yMin + pred yLength)  ) . negate  -- | Predicate.-inBounds :: (Enum y, Ord y) => y -> Bool+inBounds :: Type.Length.Y -> Bool {-# INLINE inBounds #-} inBounds y	= y >= yMin && y <= yMax  -- | Translate the specified ordinate.-translate :: (Enum y, Ord y) => (y -> y) -> y -> y+translate :: (Type.Length.Y -> Type.Length.Y) -> Type.Length.Y -> Type.Length.Y translate transformation	= (\y -> Control.Exception.assert (inBounds y) y) . transformation  -- | Where legal, translate the specified ordinate.-maybeTranslate :: (Enum y, Ord y) => (y -> y) -> y -> Maybe y+maybeTranslate :: (Type.Length.Y -> Type.Length.Y) -> Type.Length.Y -> Maybe Type.Length.Y maybeTranslate transformation	= ( 	\y -> if inBounds y 		then Just y 		else Nothing  ) . transformation----- | A boxed array indexed by /coordinates/, of arbitrary elements.-type ArrayByOrdinate y	= Data.Array.IArray.Array {-Boxed-} y---- | Array-constructor.-listArrayByOrdinate :: (-	Data.Array.IArray.IArray	a e,-	Data.Array.IArray.Ix		y,-	Enum				y- ) => [e] -> a y e-listArrayByOrdinate	= Data.Array.IArray.listArray yBounds 

@@ -19,13 +19,10 @@ {- |  [@AUTHOR@]	Dr. Alistair Ward - [@DESCRIPTION@]	Describes a line's magnitude & direction, irrespective of its position.+ [@DESCRIPTION@]	Describes a line's magnitude & direction, irrespective of its position; cf. 'Component.Move.Move'. -}  module BishBosh.Cartesian.Vector(--- * Types--- ** Type-synonyms-	VectorInt, -- ** Data-types 	Vector( --		MkVector,@@ -41,7 +38,6 @@ 	maybeTranslate, 	toMaybeDirection, -- ** Constructor-	mkVector, 	measureDistance, -- ** Predicates --	hasDistance,@@ -54,129 +50,127 @@ 	matchesPawnDoubleAdvance ) where -import			Control.Arrow((***))+import			Control.Arrow((&&&), (***)) import qualified	BishBosh.Attribute.Direction		as Attribute.Direction import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour-import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates-import qualified	BishBosh.Cartesian.Ordinate		as Cartesian.Ordinate-import qualified	BishBosh.Data.Enum			as Data.Enum import qualified	BishBosh.Property.Opposable		as Property.Opposable import qualified	BishBosh.Property.Orientated		as Property.Orientated import qualified	BishBosh.Type.Length			as Type.Length import qualified	Control.DeepSeq-import qualified	Control.Exception  -- | The distance between two /coordinates/.-data Vector distance = MkVector {-	getXDistance	:: !distance,-	getYDistance	:: !distance+data Vector	= MkVector {+	getXDistance	:: ! Type.Length.X,+	getYDistance	:: ! Type.Length.Y } deriving (Eq, Show) -instance Num distance => Property.Opposable.Opposable (Vector distance) where-	getOpposite (MkVector xDistance yDistance)	= MkVector (negate xDistance) (negate yDistance)+instance Control.DeepSeq.NFData Vector where+	rnf MkVector {+		getXDistance	= xDistance,+		getYDistance	= yDistance+	} = Control.DeepSeq.rnf (xDistance, yDistance) --- | Whether the vector has a non-zero length (or a well-defined direction).-hasDistance :: (Eq distance, Num distance) => distance -> distance -> Bool-hasDistance xDistance yDistance	= xDistance /= 0 || yDistance /= 0+instance Property.Opposable.Opposable Vector where+	getOpposite MkVector {+		getXDistance	= xDistance,+		getYDistance	= yDistance+	} = MkVector (negate xDistance) (negate yDistance) --- | Smart constructor.-mkVector :: (Num distance, Ord distance) => distance -> distance -> Vector distance-{-# INLINE mkVector #-}-mkVector xDistance yDistance	= Control.Exception.assert (-	hasDistance xDistance yDistance && abs xDistance < fromIntegral Cartesian.Abscissa.xLength && abs yDistance < fromIntegral Cartesian.Ordinate.yLength- ) $ MkVector xDistance yDistance+instance Property.Orientated.Orientated Vector where+	isDiagonal	= isDiagonal+	isParallel	= isParallel +-- | Whether the vector has a non-zero length (or a well-defined direction).+hasDistance :: Type.Length.X -> Type.Length.Y -> Bool+hasDistance 0 0	= False+hasDistance _ _	= True+ -- | Construct a /vector/ by measuring the signed distance between source-/coordinates/ & destination.-measureDistance :: (-	Enum	x,-	Enum	y,-	Num	distance,-	Ord	distance- )-	=> Cartesian.Coordinates.Coordinates x y	-- ^ Source.-	-> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.-	-> Vector distance-{-# INLINE measureDistance #-}-measureDistance source destination	= uncurry mkVector $ Cartesian.Coordinates.measureDistance source destination+measureDistance+	:: Cartesian.Coordinates.Coordinates	-- ^ Source.+	-> Cartesian.Coordinates.Coordinates	-- ^ Destination.+	-> Vector+measureDistance source destination	= uncurry MkVector $ Cartesian.Coordinates.measureDistance source destination  -- | Whether the specified /vector/ is at 45 degrees to an edge of the board, i.e. any move a @Bishop@ could make.-isDiagonal :: (Eq distance, Num distance) => Vector distance -> Bool-{-# INLINE isDiagonal #-}	-- N.B.: highly effective.-isDiagonal (MkVector xDistance yDistance)	= abs xDistance == abs yDistance+isDiagonal :: Vector -> Bool+{-# INLINE isDiagonal #-}+isDiagonal MkVector {+	getXDistance	= xDistance,+	getYDistance	= yDistance+} = fromEnum (abs xDistance) == fromEnum (abs yDistance)  -- | Whether the specified /vector/ is parallel to an edge of the board, i.e. any move a @Rook@ could make.-isParallel :: (Eq distance, Num distance) => Vector distance -> Bool+isParallel :: Vector -> Bool {-# INLINE isParallel #-}-isParallel (MkVector xDistance yDistance)	= xDistance == 0 || yDistance == 0+isParallel MkVector { getXDistance = 0 }	= True+isParallel MkVector { getYDistance = 0 }	= True+isParallel _					= False  -- | Whether the specified /vector/ is either parallel or at 45 degrees to an edge of the board, i.e. any move a @Queen@ could make.-isStraight :: (Eq distance, Num distance) => Vector distance -> Bool-{-# INLINE isStraight #-}-isStraight vector	= isParallel vector || isDiagonal vector---- | A suitable concrete type.-type VectorInt	= Vector Type.Length.Distance--instance Control.DeepSeq.NFData	distance => Control.DeepSeq.NFData (Vector distance) where-	rnf MkVector { getXDistance = xDistance, getYDistance = yDistance }	= Control.DeepSeq.rnf (xDistance, yDistance)--instance (Eq distance, Num distance) => Property.Orientated.Orientated (Vector distance) where-	{-# SPECIALISE instance Property.Orientated.Orientated VectorInt #-}-	isDiagonal	= isDiagonal-	isParallel	= isParallel+isStraight :: Vector -> Bool+isStraight	= uncurry (||) . (isParallel &&& isDiagonal)  {- | 	* The list of attack-vectors for a @Pawn@.  	* N.B.: the @Pawn@'s ability to advance without taking, isn't dealt with here. -}-attackVectorsForPawn :: Num distance => Attribute.LogicalColour.LogicalColour -> [Vector distance]+attackVectorsForPawn :: Attribute.LogicalColour.LogicalColour -> [Vector] attackVectorsForPawn logicalColour	= [-	MkVector x $ (-		if Attribute.LogicalColour.isBlack logicalColour-			then negate	-- Black moves down.-			else id		-- White moves up.-	) 1 | x	<- [negate 1, 1]+	MkVector {+		getXDistance	= x,+		getYDistance	= (+			if Attribute.LogicalColour.isBlack logicalColour+				then negate	-- Black moves down.+				else id		-- White moves up.+		) 1+	} | x	<- [negate 1, 1]  ] -- List-comprehension.  -- | The constant list of attack-vectors for a @Knight@.-attackVectorsForKnight :: Num distance => [Vector distance]+attackVectorsForKnight :: [Vector] attackVectorsForKnight	= [-	MkVector (fX xDistance) (fY $ 3 - xDistance) |-		fX		<- negateOrNot,-		fY		<- negateOrNot,+	MkVector {+		getXDistance	= fX xDistance,+		getYDistance	= fY $ 3 - fromIntegral xDistance+	} |+		fX		<- [negate, id],+		fY		<- [negate, id], 		xDistance	<- [1, 2]- ] where-	negateOrNot	= [negate, id]+ ]  -- | The constant list of attack-vectors for a @King@.-attackVectorsForKing :: (Eq distance, Num distance) => [Vector distance]+attackVectorsForKing :: [Vector] attackVectorsForKing	= [ 	MkVector xDistance yDistance |-		xDistance	<- signumValues,-		yDistance	<- signumValues,+		xDistance	<- [negate 1, 0, 1],+		yDistance	<- [negate 1, 0, 1], 		hasDistance xDistance yDistance- ] where-	signumValues	= [negate 1, 0, 1]+ ]  {- | 	* Whether the specified /vector/ might represent an attack (rather than an advance) by a @Pawn@.  	* CAVEAT: if the move started at the first rank, then it can't be a @Pawn@, but that's beyond the scope of this module (since a /Vector/ doesn't define absolute /coordinate/s). -}-isPawnAttack :: (Eq distance, Num distance) => Attribute.LogicalColour.LogicalColour -> Vector distance -> Bool+isPawnAttack :: Attribute.LogicalColour.LogicalColour -> Vector -> Bool {-# INLINE isPawnAttack #-}-isPawnAttack logicalColour (MkVector xDistance yDistance)	= abs xDistance == 1 && yDistance == (-	if Attribute.LogicalColour.isBlack logicalColour-		then negate-		else id- ) 1+isPawnAttack logicalColour MkVector {+	getXDistance	= xDistance,+	getYDistance	= yDistance+} = abs xDistance == 1 && yDistance == if Attribute.LogicalColour.isBlack logicalColour+	then negate 1+	else 1  -- | Whether the specified /vector/ represents a move a @Knight@ could make.-isKnightsMove :: (Eq distance, Num distance) => Vector distance -> Bool+isKnightsMove :: Vector -> Bool {-# INLINE isKnightsMove #-}-isKnightsMove (MkVector xDistance yDistance)	= case abs xDistance of+isKnightsMove MkVector {+	getXDistance	= xDistance,+	getYDistance	= yDistance+} = case abs xDistance of 	1	-> absYDistance == 2 	2	-> absYDistance == 1 	_	-> False@@ -184,65 +178,45 @@ 		absYDistance	= abs yDistance  -- | Whether the specified /vector/ represents a move a @King@ could make.-isKingsMove :: (Num distance, Ord distance) => Vector distance -> Bool-isKingsMove (MkVector 0 0)			= False-isKingsMove (MkVector xDistance yDistance)	= abs xDistance <= 1 && abs yDistance <= 1+isKingsMove :: Vector -> Bool+isKingsMove MkVector {+	getXDistance	= xDistance,+	getYDistance	= yDistance+} = abs xDistance <= 1 && abs yDistance <= 1  {- | 	* Whether the specified /vector/ matches a @Pawn@'s initial double-advance move.  	* CAVEAT: passing this test doesn't guarantee that it is a @Pawn@'s double-advance move, since the move may not relate to a @Pawn@, or could be invalid. -}-matchesPawnDoubleAdvance-	:: (Eq distance, Num distance)-	=> Attribute.LogicalColour.LogicalColour-	-> Vector distance-	-> Bool-matchesPawnDoubleAdvance logicalColour (MkVector xDistance yDistance)	= xDistance == 0 && yDistance == (-	if Attribute.LogicalColour.isBlack logicalColour-		then negate-		else id- ) 2+matchesPawnDoubleAdvance :: Attribute.LogicalColour.LogicalColour -> Vector -> Bool+matchesPawnDoubleAdvance logicalColour MkVector {+	getXDistance	= 0,+	getYDistance	= yDistance+}				= yDistance == if Attribute.LogicalColour.isBlack logicalColour then negate 2 else 2+matchesPawnDoubleAdvance _ _	= False  -- | Translate the specified /coordinates/ by the specified /vector/.-translate :: (-	Enum		x,-	Enum		y,-	Integral	distance,-	Ord		x,-	Ord		y- )-	=> Cartesian.Coordinates.Coordinates x y-	-> Vector distance-	-> Cartesian.Coordinates.Coordinates x y-translate coordinates (MkVector xDistance yDistance)	= Cartesian.Coordinates.translate (-	Data.Enum.translate (+ fromIntegral xDistance) *** Data.Enum.translate (+ fromIntegral yDistance)- ) coordinates+translate :: Cartesian.Coordinates.Coordinates -> Vector -> Cartesian.Coordinates.Coordinates+translate coordinates MkVector {+	getXDistance	= xDistance,+	getYDistance	= yDistance+} = Cartesian.Coordinates.translate ((+ xDistance) *** (+ yDistance)) coordinates  -- | Where legal, translate the specified /coordinates/ by the specified /vector/.-maybeTranslate :: (-	Enum		x,-	Enum		y,-	Integral	distance,-	Ord		x,-	Ord		y- )-	=> Cartesian.Coordinates.Coordinates x y-	-> Vector distance-	-> Maybe (Cartesian.Coordinates.Coordinates x y)-{-# SPECIALISE maybeTranslate :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Vector Type.Length.Distance -> Maybe (Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y) #-}-maybeTranslate coordinates (MkVector xDistance yDistance)	= Cartesian.Coordinates.maybeTranslate (-	Data.Enum.translate (+ fromIntegral xDistance) *** Data.Enum.translate (+ fromIntegral yDistance)- ) coordinates+maybeTranslate :: Cartesian.Coordinates.Coordinates -> Vector -> Maybe Cartesian.Coordinates.Coordinates+maybeTranslate coordinates MkVector {+	getXDistance	= xDistance,+	getYDistance	= yDistance+} = Cartesian.Coordinates.maybeTranslate ((+ xDistance) *** (+ yDistance)) coordinates  {- | 	* Where possible, converts the specified /vector/ into a /direction/.  	* @Nothing@ is returned for those /vector/s which don't translate into a legal /direction/ (e.g. a @Knight@'s move). -}-toMaybeDirection :: (Num distance, Ord distance) => Vector distance -> Maybe Attribute.Direction.Direction-{-# INLINE toMaybeDirection #-}+toMaybeDirection :: Vector -> Maybe Attribute.Direction.Direction toMaybeDirection vector@(MkVector xDistance yDistance)-	| isStraight vector	= Just $ Attribute.Direction.mkDirection (compare xDistance 0) (compare yDistance 0)+	| isStraight vector	= Just $ Attribute.Direction.mkDirection (xDistance `compare` 0) (yDistance `compare` 0) 	| otherwise		= Nothing 

@@ -0,0 +1,42 @@+{-+	Copyright (C) 2021 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@]	Sum the relative values of /rank/ of piece, based on their location on the board, at a specific stage in the game.+-}++module BishBosh.Component.Accountant(+-- * Type-classes+	Accountant(..)+) where++import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank+import qualified	BishBosh.Type.Count					as Type.Count++-- | An interface which may be implemented by data which can total piece-square values.+class Accountant accountant where+	-- | Calculate the total value of the /coordinates/ occupied by the /piece/s of either side.+	sumPieceSquareValueByLogicalColour+		:: Num pieceSquareValue+		=> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue+		-> Type.Count.NPieces	-- ^ The number of pieces (of any logical colour or rank) remaining on the board; used to gauge progress through the game.+		-> accountant+		-> [pieceSquareValue]+

@@ -38,8 +38,7 @@ --	defineCastlingMoves, 	getLongAndShortMoves, -- ** Accessors-	getCastlingMoves,---	getCastlingMovesInt+	getCastlingMoves ) where  import			Control.Arrow((&&&))@@ -48,41 +47,35 @@ import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates import qualified	BishBosh.Component.Move			as Component.Move-import qualified	BishBosh.Data.Enum			as Data.Enum import qualified	BishBosh.Data.Exception			as Data.Exception import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership import qualified	BishBosh.Type.Length			as Type.Length import qualified	Control.Exception  -- | Defines a castling-move.-data CastlingMove x y	= MkCastlingMove {+data CastlingMove	= MkCastlingMove { 	getMoveType	:: Attribute.MoveType.MoveType,	-- ^ CAVEAT: should only be a castling-move type.-	getKingsMove	:: Component.Move.Move x y,-	getRooksMove	:: Component.Move.Move x y+	getKingsMove	:: Component.Move.Move,+	getRooksMove	:: Component.Move.Move } --- | The constant number of files over which the King always travels when castling.-kingsMoveLength :: Num x => x+-- | The constant number of files over which the @King@ always travels when castling.+kingsMoveLength :: Type.Length.X kingsMoveLength	= 2  -- | Define all possible castling-moves for the specified /logical colour/.-defineCastlingMoves :: (-	Enum	x,-	Enum	y,-	Eq	y,-	Ord	x- ) => Attribute.LogicalColour.LogicalColour -> [CastlingMove x y]+defineCastlingMoves :: Attribute.LogicalColour.LogicalColour -> [CastlingMove] defineCastlingMoves logicalColour	= [ 	MkCastlingMove { 		getMoveType	= Attribute.MoveType.longCastle, 		getKingsMove	= kingsMove $ subtract kingsMoveLength,-		getRooksMove	= uncurry Component.Move.mkMove . (id &&& translateX (+ 3)) $ if isBlack+		getRooksMove	= uncurry Component.Move.mkMove . (id &&& Cartesian.Coordinates.translateX (+ 3)) $ if isBlack 			then Cartesian.Coordinates.topLeft 			else minBound 	}, MkCastlingMove { 		getMoveType	= Attribute.MoveType.shortCastle, 		getKingsMove	= kingsMove (+ kingsMoveLength),-		getRooksMove	= uncurry Component.Move.mkMove . (id &&& translateX (subtract 2)) $ if isBlack+		getRooksMove	= uncurry Component.Move.mkMove . (id &&& Cartesian.Coordinates.translateX (subtract 2)) $ if isBlack 			then maxBound 			else Cartesian.Coordinates.bottomRight 	}@@ -90,19 +83,10 @@ 	isBlack :: Bool 	isBlack	= Attribute.LogicalColour.isBlack logicalColour -	kingsStartingCoordinates	= Cartesian.Coordinates.kingsStartingCoordinates logicalColour-	kingsMove translation		= Component.Move.mkMove kingsStartingCoordinates $ translateX translation kingsStartingCoordinates--	translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y-	translateX	= Cartesian.Coordinates.translateX . Data.Enum.translate+	kingsMove translation	= uncurry ($) . (Component.Move.mkMove &&& Cartesian.Coordinates.translateX translation) $ Cartesian.Coordinates.kingsStartingCoordinates logicalColour  -- | Defines by /logical colour/, the constant list of all possible castling-moves.-castlingMovesByLogicalColour :: (-	Enum	x,-	Enum	y,-	Eq	y,-	Ord	x- ) => Attribute.LogicalColour.ArrayByLogicalColour [CastlingMove x y]+castlingMovesByLogicalColour :: Attribute.LogicalColour.ArrayByLogicalColour [CastlingMove] castlingMovesByLogicalColour	= Attribute.LogicalColour.listArrayByLogicalColour $ map defineCastlingMoves Property.FixedMembership.members  {- |@@ -110,28 +94,11 @@  	* CAVEAT: the moves are returned in unspecified order. -}-getCastlingMoves :: (-	Enum	x,-	Enum	y,-	Eq	y,-	Ord	x- ) => Attribute.LogicalColour.LogicalColour -> [CastlingMove x y]-{-# NOINLINE getCastlingMoves #-}	-- Ensure the rewrite-rule triggers.-{-# RULES "getCastlingMoves/Int" getCastlingMoves = getCastlingMovesInt #-}-getCastlingMoves	= defineCastlingMoves---- | A specialisation of 'getCastlingMoves'.-getCastlingMovesInt :: Attribute.LogicalColour.LogicalColour -> [CastlingMove Type.Length.X Type.Length.Y]-getCastlingMovesInt	= (castlingMovesByLogicalColour !)+getCastlingMoves :: Attribute.LogicalColour.LogicalColour -> [CastlingMove]+getCastlingMoves	= (castlingMovesByLogicalColour !)  -- | Break-down the two castling-moves for the specified /logical colour/ into a long & a short castling-move.-getLongAndShortMoves :: (-	Enum	x,-	Enum	y,-	Eq	y,-	Ord	x- ) => Attribute.LogicalColour.LogicalColour -> (CastlingMove x y, CastlingMove x y)-{-# SPECIALISE getLongAndShortMoves :: Attribute.LogicalColour.LogicalColour -> (CastlingMove Type.Length.X Type.Length.Y, CastlingMove Type.Length.X Type.Length.Y) #-}+getLongAndShortMoves :: Attribute.LogicalColour.LogicalColour -> (CastlingMove, CastlingMove) getLongAndShortMoves logicalColour 	| [longCastlingMove, shortCastlingMove] <- getCastlingMoves logicalColour	= (longCastlingMove, shortCastlingMove) 	| otherwise									= Control.Exception.throw $ Data.Exception.mkIncompatibleData "BishBosh.Component.CastlingMove.getLongAndShortMoves:\tunexpected list-length."

@@ -49,16 +49,16 @@ import qualified	BishBosh.Component.Move		as Component.Move  -- | As returned by 'Notation.MoveNotation.readsQualifiedMove'.-data EitherQualifiedMove x y	= MkEitherQualifiedMove {-	getMove				:: Component.Move.Move x y,+data EitherQualifiedMove	= MkEitherQualifiedMove {+	getMove				:: Component.Move.Move, 	getPromotionRankOrMoveType	:: Either (Maybe Attribute.Rank.Rank) Attribute.MoveType.MoveType	-- ^ Either the optional /rank/ to which a @Pawn@ should be promoted, or the complete /move-type/. }  -- | Constructor for notations which don't encode sufficient information to reliably re-construct the /move-type/, but merely the /rank/ to which a @Pawn@ is to be promoted.-mkPartiallyQualifiedMove :: Component.Move.Move x y -> Maybe Attribute.Rank.Rank -> EitherQualifiedMove x y+mkPartiallyQualifiedMove :: Component.Move.Move -> Maybe Attribute.Rank.Rank -> EitherQualifiedMove mkPartiallyQualifiedMove move	= MkEitherQualifiedMove move . Left  -- | Constructor for notations which encode sufficient information to reliably re-construct the /move-type/.-mkFullyQualifiedMove :: Component.Move.Move x y -> Attribute.MoveType.MoveType -> EitherQualifiedMove x y+mkFullyQualifiedMove :: Component.Move.Move -> Attribute.MoveType.MoveType -> EitherQualifiedMove mkFullyQualifiedMove move	= MkEitherQualifiedMove move . Right 

@@ -19,7 +19,11 @@ {- |  [@AUTHOR@]	Dr. Alistair Ward - [@DESCRIPTION@]	Defines one move (actually just a half move AKA "ply") of a /piece/.+ [@DESCRIPTION@]++	* Defines one move (actually just a half move AKA "ply") of a /piece/.++	* Similar to 'Cartesian.Vector.Vector', but the position is fixed. -}  module BishBosh.Component.Move(@@ -49,7 +53,6 @@ import qualified	BishBosh.Property.Orientated		as Property.Orientated import qualified	BishBosh.Property.Reflectable		as Property.Reflectable import qualified	BishBosh.Type.Count			as Type.Count-import qualified	BishBosh.Type.Length			as Type.Length import qualified	Control.Arrow import qualified	Control.DeepSeq import qualified	Control.Exception@@ -68,50 +71,45 @@  	* Most modern chess-notations (except Standard Algebraic) start with similar information, but also define ancillary information which is captured in /MoveType/. -}-data Move x y	= MkMove {-	getSource	:: Cartesian.Coordinates.Coordinates x y,-	getDestination	:: Cartesian.Coordinates.Coordinates x y+data Move	= MkMove {+	getSource	:: Cartesian.Coordinates.Coordinates,+	getDestination	:: Cartesian.Coordinates.Coordinates } deriving Eq -instance (Ord x, Ord y) => Ord (Move x y) where-	{-# SPECIALISE instance Ord (Move Type.Length.X Type.Length.Y) #-}+instance Ord Move where 	move@MkMove { getSource = source } `compare` move'@MkMove { getSource = source' }	= case source `compare` source' of 		EQ		-> Data.Ord.comparing getDestination move move' 		ordering	-> ordering -instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Move x y) where+instance Control.DeepSeq.NFData Move where 	rnf MkMove { 		getSource	= source, 		getDestination	= destination 	} = Control.DeepSeq.rnf (source, destination) -instance (Show x, Show y) => Show (Move x y) where+instance Show Move where 	showsPrec precedence MkMove { 		getSource	= source, 		getDestination	= destination 	} = showsPrec precedence (source, destination) -instance (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Read	x,-	Read	y- ) => Read (Move x y) where+instance Read Move where 	readsPrec precedence	= map (Control.Arrow.first $ uncurry mkMove) . readsPrec precedence -instance Property.Opposable.Opposable (Move x y) where-	getOpposite (MkMove source destination)	= MkMove {+instance Property.Opposable.Opposable Move where+	getOpposite MkMove {+		getSource	= source,+		getDestination	= destination+	} = MkMove { 		getSource	= destination, 		getDestination	= source 	} -instance (Enum x, Enum y) => Property.Orientated.Orientated (Move x y) where-	isDiagonal	= (Property.Orientated.isDiagonal :: Cartesian.Vector.VectorInt -> Bool) . measureDistance-	isParallel	= (Property.Orientated.isParallel :: Cartesian.Vector.VectorInt -> Bool) . measureDistance+instance Property.Orientated.Orientated Move where+	isDiagonal	= Property.Orientated.isDiagonal . measureDistance+	isParallel	= Property.Orientated.isParallel . measureDistance -instance Enum y => Property.Reflectable.ReflectableOnX (Move x y) where+instance Property.Reflectable.ReflectableOnX Move where 	reflectOnX MkMove { 		getSource	= source, 		getDestination	= destination@@ -120,7 +118,7 @@ 		getDestination	= Property.Reflectable.reflectOnX destination 	} -instance Enum x => Property.Reflectable.ReflectableOnY (Move x y) where+instance Property.Reflectable.ReflectableOnY Move where 	reflectOnY MkMove { 		getSource	= source, 		getDestination	= destination@@ -131,10 +129,9 @@  -- | Smart constructor. mkMove-	:: (Eq x, Eq y)-	=> Cartesian.Coordinates.Coordinates x y-	-> Cartesian.Coordinates.Coordinates x y-	-> Move x y+	:: Cartesian.Coordinates.Coordinates+	-> Cartesian.Coordinates.Coordinates+	-> Move {-# INLINE mkMove #-} mkMove source destination	= Control.Exception.assert (source /= destination) MkMove { 	getSource	= source,@@ -142,26 +139,14 @@ }  -- | Measures the signed distance between the ends of the move.-measureDistance :: (-	Enum	x,-	Enum	y,-	Num	distance,-	Ord	distance- ) => Move x y -> Cartesian.Vector.Vector distance-{-# SPECIALISE measureDistance :: Move Type.Length.X Type.Length.Y -> Cartesian.Vector.VectorInt #-}+measureDistance :: Move -> Cartesian.Vector.Vector measureDistance	MkMove { 	getSource	= source, 	getDestination	= destination } = Cartesian.Vector.measureDistance source destination  -- | Generates a line of /coordinates/ covering the half open interval @(source, destination]@.-interpolate :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- ) => Move x y -> [Cartesian.Coordinates.Coordinates x y]-{-# SPECIALISE interpolate :: Move Type.Length.X Type.Length.Y -> [Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y] #-}+interpolate :: Move -> [Cartesian.Coordinates.Coordinates] interpolate move@MkMove { 	getSource	= source, 	getDestination	= destination@@ -174,13 +159,10 @@ 	but passing only guarantees that it is, if it was a @Pawn@ which moved & that the /move/ is valid. -} isPawnDoubleAdvance-	:: (Enum x, Enum y, Eq y)-	=> Attribute.LogicalColour.LogicalColour	-- Defines the side whose move is referenced.-	-> Move x y+	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side whose move is referenced.+	-> Move 	-> Bool-isPawnDoubleAdvance logicalColour move	= Cartesian.Coordinates.isPawnsFirstRank logicalColour (-	getSource move- ) && Cartesian.Vector.matchesPawnDoubleAdvance logicalColour (-	measureDistance move :: Cartesian.Vector.VectorInt+isPawnDoubleAdvance logicalColour move@MkMove { getSource = source }	= Cartesian.Coordinates.isPawnsFirstRank logicalColour source && Cartesian.Vector.matchesPawnDoubleAdvance logicalColour (+	measureDistance move  ) 

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP, LambdaCase #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -29,7 +28,7 @@ -- ** Type-synonyms --	ByRankByLogicalColour, --	AttackDestinationsByCoordinatesByRankByLogicalColour,---	ArrayByPiece,+	ArrayByPiece, 	LocatedPiece, -- ** Data-types 	Piece(@@ -39,15 +38,15 @@ 	), -- * Constants --	tag,-	nPiecesPerSide, 	range,+	nPiecesPerSide,+	epdCharacterSet, --	attackVectorsByRankByLogicalColour, --	attackDirectionsByRankByLogicalColour, --	attackDestinationsByCoordinatesByRankByLogicalColour, -- * Functions --	findAttackDestinations', 	findAttackDestinations,---	findAttackDestinationsInt, 	showPieces, -- ** Accessors 	getAttackDirections,@@ -62,7 +61,7 @@ 	mkPiece, 	mkQueen, 	mkRook,---	listArrayByPiece,+	listArrayByPiece, -- ** Predicates 	canAttackAlong, 	canMoveBetween,@@ -83,22 +82,22 @@ import qualified	BishBosh.Attribute.Direction			as Attribute.Direction import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour import qualified	BishBosh.Attribute.Rank				as Attribute.Rank-import qualified	BishBosh.Cartesian.Abscissa			as Cartesian.Abscissa import qualified	BishBosh.Cartesian.Coordinates			as Cartesian.Coordinates import qualified	BishBosh.Cartesian.Ordinate			as Cartesian.Ordinate import qualified	BishBosh.Cartesian.Vector			as Cartesian.Vector+import qualified	BishBosh.Data.Exception				as Data.Exception import qualified	BishBosh.Property.ExtendedPositionDescription	as Property.ExtendedPositionDescription import qualified	BishBosh.Property.FixedMembership		as Property.FixedMembership import qualified	BishBosh.Property.ForsythEdwards		as Property.ForsythEdwards import qualified	BishBosh.Property.Opposable			as Property.Opposable import qualified	BishBosh.Type.Count				as Type.Count-import qualified	BishBosh.Type.Length				as Type.Length import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.Array.IArray import qualified	Data.Char+import qualified	Data.Foldable import qualified	Data.List.Extra-import qualified	Data.Map+import qualified	Data.Map					as Map import qualified	Data.Maybe import qualified	Text.XML.HXT.Arrow.Pickle			as HXT import qualified	Text.XML.HXT.Arrow.Pickle.Schema@@ -111,9 +110,9 @@ tag :: String tag	= "piece" --- | The initial number of pieces per side in a standard opening position; some of which are duplicates.+-- | The constant number of pieces per side at the conventional opening position; some of which are duplicates. nPiecesPerSide :: Type.Count.NPieces-nPiecesPerSide	= fromIntegral $ Cartesian.Abscissa.xLength * 2 {-rows-}+nPiecesPerSide	= Data.Foldable.foldl' (+) 0 Attribute.Rank.initialAllocationByRankPerSide  -- | A Chess-piece has a /logical colour/ & a /rank/. data Piece	= MkPiece {@@ -141,6 +140,10 @@ instance Show Piece where 	showsPrec _	= Property.ForsythEdwards.showsFEN +-- | The constant set of permissible characters in an EPD.+epdCharacterSet	:: Property.ExtendedPositionDescription.EPD+epdCharacterSet	= concatMap Property.ExtendedPositionDescription.showEPD range+ instance Property.ExtendedPositionDescription.ReadsEPD Piece where 	readsEPD s	= case Data.List.Extra.trimStart s of 		c : remainder	-> (@@ -197,11 +200,11 @@  -- | Constructor. mkPawn :: Attribute.LogicalColour.LogicalColour -> Piece-mkPawn		= (`MkPiece` Attribute.Rank.Pawn)+mkPawn	= (`MkPiece` Attribute.Rank.Pawn)  -- | Constructor. mkRook :: Attribute.LogicalColour.LogicalColour -> Piece-mkRook		= (`MkPiece` Attribute.Rank.Rook)+mkRook	= (`MkPiece` Attribute.Rank.Rook)  -- | Constructor. mkKnight :: Attribute.LogicalColour.LogicalColour -> Piece@@ -213,22 +216,21 @@  -- | Constructor. mkQueen :: Attribute.LogicalColour.LogicalColour -> Piece-mkQueen		= (`MkPiece` Attribute.Rank.Queen)+mkQueen	= (`MkPiece` Attribute.Rank.Queen)  -- | Constructor. mkKing :: Attribute.LogicalColour.LogicalColour -> Piece-mkKing		= (`MkPiece` Attribute.Rank.King)--{- |-	* Changes the specified /piece/ to the specified /rank/ leaving its /logical colour/ unchanged.+mkKing	= (`MkPiece` Attribute.Rank.King) -	* CAVEAT: only legal if the unspecifed original /rank/ was a @Pawn@, & becomes neither a @Pawn@ nor a @King@.--}+-- | Changes the specified /piece/ to the specified /rank/ leaving its /logical colour/ unchanged. promote :: Attribute.Rank.Rank -> Piece -> Piece-promote newRank piece	= piece { getRank = newRank }+promote newRank piece+	| not $ isPawn piece					= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Component.Piece.promote:\tcan't promote a " $ shows piece "."+	| newRank `notElem` Attribute.Rank.promotionProspects	= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Component.Piece.promote:\tcan't promote to a " $ shows newRank "."+	| otherwise						= piece { getRank = newRank }  -- | The structure of a container of arbitrary data, indexed by /logicalColour/ & some /rank/s.-type ByRankByLogicalColour element	= Attribute.LogicalColour.ArrayByLogicalColour (Data.Map.Map Attribute.Rank.Rank element)+type ByRankByLogicalColour element	= Attribute.LogicalColour.ArrayByLogicalColour (Map.Map Attribute.Rank.Rank element)  -- | Constructor of a certain shape of container, but with arbitrary contents. mkByRankByLogicalColour ::@@ -241,7 +243,7 @@ 	. Control.Parallel.Strategies.withStrategy (Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq) #endif 	$ map (-		\logicalColour	-> Data.Map.fromList $ map (id &&& mkElement logicalColour) ranks+		\logicalColour	-> Map.fromList $ map (id &&& mkElement logicalColour) ranks 	) Property.FixedMembership.members  {- |@@ -251,13 +253,7 @@  	* CAVEAT: it doesn't identify @Pawn@-advances, since these aren't attacks. -}-attackVectorsByRankByLogicalColour :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	distance,-#endif-	Num			distance,-	Ord			distance- ) => ByRankByLogicalColour [Cartesian.Vector.Vector distance]+attackVectorsByRankByLogicalColour :: ByRankByLogicalColour [Cartesian.Vector.Vector] attackVectorsByRankByLogicalColour	= mkByRankByLogicalColour Attribute.Rank.fixedAttackRange $ \logicalColour -> \case 	Attribute.Rank.Pawn	-> Cartesian.Vector.attackVectorsForPawn logicalColour 	Attribute.Rank.Knight	-> Cartesian.Vector.attackVectorsForKnight@@ -265,8 +261,22 @@ 	rank			-> error . showString "BishBosh.Component.Piece.attackVectorsByRankByLogicalColour:\trank must attack over fixed range; " $ shows rank "."	-- These ranks attack over any distance.  -- | The destinations available to those pieces with attack-vectors; @Pawn@, @Knight@, @King@.-type AttackDestinationsByCoordinatesByRankByLogicalColour x y	= ByRankByLogicalColour (Cartesian.Coordinates.ArrayByCoordinates x y [Cartesian.Coordinates.Coordinates x y])+type AttackDestinationsByCoordinatesByRankByLogicalColour	= ByRankByLogicalColour (Cartesian.Coordinates.ArrayByCoordinates [Cartesian.Coordinates.Coordinates]) +-- | Calls 'attackVectorsByRankByLogicalColour' to find the destinations which the specified /piece/ can attack from the specified position.+findAttackDestinations'+	:: Cartesian.Coordinates.Coordinates	-- ^ The source from which the attack originates.+	-> Piece+	-> [Cartesian.Coordinates.Coordinates]	-- ^ The destinations which can be attacked.+findAttackDestinations' source MkPiece {+	getLogicalColour	= logicalColour,+	getRank			= rank+} = Data.Maybe.mapMaybe (+	Cartesian.Vector.maybeTranslate source+ ) (+	attackVectorsByRankByLogicalColour ! logicalColour Map.! rank+ )+ {- | 	* The destinations available to those pieces with attack-vectors; @Pawn@, @Knight@, @King@. @@ -274,60 +284,20 @@  	* CAVEAT: this function has no knowledge of the /board/, & therefore of the position of any other piece. -}-attackDestinationsByCoordinatesByRankByLogicalColour :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y,-#endif-	Enum			x,-	Enum			y,-	Ord			x,-	Ord			y- ) => AttackDestinationsByCoordinatesByRankByLogicalColour x y-{-# SPECIALISE attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour Type.Length.X Type.Length.Y #-}	-- To promote memoisation.+attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour attackDestinationsByCoordinatesByRankByLogicalColour	= mkByRankByLogicalColour Attribute.Rank.fixedAttackRange $ \logicalColour rank -> Cartesian.Coordinates.listArrayByCoordinates $ map ( 	`findAttackDestinations'` mkPiece logicalColour rank  ) Property.FixedMembership.members --- | Calls 'attackVectorsByRankByLogicalColour' to find the destinations which the specified /piece/ can attack from the specified position.-findAttackDestinations' :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> Cartesian.Coordinates.Coordinates x y	-- ^ The source from which the attack originates.-	-> Piece-	-> [Cartesian.Coordinates.Coordinates x y]	-- ^ The destinations which can be attacked.-findAttackDestinations' source MkPiece {-	getLogicalColour	= logicalColour,-	getRank			= rank-} = Data.Maybe.mapMaybe (-	Cartesian.Vector.maybeTranslate source- ) (-	attackVectorsByRankByLogicalColour ! logicalColour Data.Map.! rank :: [Cartesian.Vector.VectorInt]- )- -- | Find the destinations which the specified /piece/ can attack from the specified position.-findAttackDestinations :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> Cartesian.Coordinates.Coordinates x y	-- ^ The source from which the attack originates.+findAttackDestinations+	:: Cartesian.Coordinates.Coordinates	-- ^ The source from which the attack originates. 	-> Piece-	-> [Cartesian.Coordinates.Coordinates x y]	-- ^ The destinations which can be attacked.-{-# NOINLINE findAttackDestinations #-}	-- Ensure the rewrite-rule triggers.-{-# RULES "findAttackDestinations/Int" findAttackDestinations = findAttackDestinationsInt #-}	-- CAVEAT: the call-stack leading to this function must be specialised to ensure this triggers.-findAttackDestinations	= findAttackDestinations'---- | A specialisation of 'findAttackDestinations', more efficiently implemented by calling 'attackDestinationsByCoordinatesByRankByLogicalColour'.-findAttackDestinationsInt :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Piece -> [Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y]-findAttackDestinationsInt coordinates MkPiece {+	-> [Cartesian.Coordinates.Coordinates]	-- ^ The destinations which can be attacked.+findAttackDestinations coordinates MkPiece { 	getLogicalColour	= logicalColour, 	getRank			= rank-} = attackDestinationsByCoordinatesByRankByLogicalColour ! logicalColour Data.Map.! rank ! coordinates+} = attackDestinationsByCoordinatesByRankByLogicalColour ! logicalColour Map.! rank ! coordinates  -- The constant /direction/s of the straight lines along which each type of /piece/ can attack. @@ -353,7 +323,7 @@ getAttackDirections MkPiece { 	getLogicalColour	= logicalColour, 	getRank			= rank-} = attackDirectionsByRankByLogicalColour ! logicalColour Data.Map.! rank+} = attackDirectionsByRankByLogicalColour ! logicalColour Map.! rank  {- | 	* Whether a /piece/ at the specified /coordinates/ could attack the target at the specified /coordinates/.@@ -365,12 +335,10 @@ 	* CAVEAT: it won't confirm the ability of a @Pawn@ to advance, since that doesn't constitute an attack. -} canAttackAlong-	:: (Enum x, Enum y)-	=> Cartesian.Coordinates.Coordinates x y	-- ^ Source (attacker's location).-	-> Cartesian.Coordinates.Coordinates x y	-- ^ Destination (victim's location).-	-> Piece					-- ^ Attacker.+	:: Cartesian.Coordinates.Coordinates	-- ^ Source (attacker's location).+	-> Cartesian.Coordinates.Coordinates	-- ^ Destination (victim's location).+	-> Piece				-- ^ Attacker. 	-> Bool-{-# SPECIALISE canAttackAlong :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Piece -> Bool #-} canAttackAlong source destination piece	= ( 	case getRank piece of 		Attribute.Rank.Pawn	-> Cartesian.Vector.isPawnAttack $ getLogicalColour piece@@ -380,7 +348,7 @@ 		Attribute.Rank.Queen	-> Cartesian.Vector.isStraight 		Attribute.Rank.King	-> Cartesian.Vector.isKingsMove  ) (-	Cartesian.Vector.measureDistance source destination	:: Cartesian.Vector.VectorInt+	Cartesian.Vector.measureDistance source destination  )  {- |@@ -388,16 +356,11 @@  	* N.B.: can't detect any blocking pieces. -}-canMoveBetween :: (-	Enum	x,-	Enum	y,-	Eq	y- )-	=> Cartesian.Coordinates.Coordinates x y	-- ^ Source.-	-> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.+canMoveBetween+	:: Cartesian.Coordinates.Coordinates	-- ^ Source.+	-> Cartesian.Coordinates.Coordinates	-- ^ Destination. 	-> Piece 	-> Bool-{-# SPECIALISE canMoveBetween :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Piece -> Bool #-} canMoveBetween source destination piece	= ( 	case getRank piece of 		Attribute.Rank.Pawn	-> \distance -> let@@ -417,13 +380,12 @@ 		Attribute.Rank.Queen	-> Cartesian.Vector.isStraight 		Attribute.Rank.King	-> Cartesian.Vector.isKingsMove  ) (-	Cartesian.Vector.measureDistance source destination	:: Cartesian.Vector.VectorInt+	Cartesian.Vector.measureDistance source destination  )  -- | Whether a move qualifies for @Pawn@-promotion. isPawnPromotion-	:: (Enum y, Eq y)-	=> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.+	:: Cartesian.Coordinates.Coordinates	-- ^ Destination. 	-> Piece 	-> Bool isPawnPromotion destination MkPiece {@@ -488,5 +450,5 @@ listArrayByPiece	= Data.Array.IArray.listArray (minBound, maxBound)  -- | A /piece/ at specific /coordinates/.-type LocatedPiece x y	= (Cartesian.Coordinates.Coordinates x y, Piece)+type LocatedPiece	= (Cartesian.Coordinates.Coordinates, Piece) 

@@ -27,8 +27,6 @@ -- ** Type-synonyms --	PieceSquareValueByNPieces, --	EitherPieceSquareValueByNPiecesByCoordinates,-	FindPieceSquareValue,-	FindPieceSquareValues, -- ** Data-types 	PieceSquareByCoordinatesByRank( --		MkPieceSquareByCoordinatesByRank,@@ -39,7 +37,6 @@ 	gnuPlotComment, -- * Functions 	findPieceSquareValue,-	findPieceSquareValues, 	interpolatePieceSquareValues, 	formatForGNUPlot, -- ** Constructor@@ -57,10 +54,9 @@ import qualified	BishBosh.Property.Reflectable		as Property.Reflectable import qualified	BishBosh.Text.ShowList			as Text.ShowList import qualified	BishBosh.Type.Count			as Type.Count-import qualified	BishBosh.Type.Length			as Type.Length-import qualified	BishBosh.Type.Mass			as Type.Mass import qualified	Control.DeepSeq import qualified	Data.Array.IArray+import qualified	Data.Foldable import qualified	Data.List  -- | The piece-square value may vary as the game progresses.@@ -74,105 +70,41 @@  )  -- | Self-documentation.-type EitherPieceSquareValueByNPiecesByCoordinates x y pieceSquareValue	= Either (-	Cartesian.Coordinates.ArrayByCoordinates x y pieceSquareValue	-- Uninterpolated.+type EitherPieceSquareValueByNPiecesByCoordinates pieceSquareValue	= Either (+	Cartesian.Coordinates.ArrayByCoordinates pieceSquareValue	-- Uninterpolated.  ) (-	Cartesian.Coordinates.ArrayByCoordinates x y (PieceSquareValueByNPieces pieceSquareValue)	-- Interpolated.+	Cartesian.Coordinates.ArrayByCoordinates (PieceSquareValueByNPieces pieceSquareValue)	-- Interpolated.  )  -- | The value for each type of /piece/ of occupying each coordinate, at each stage in the lifetime of the game.-newtype PieceSquareByCoordinatesByRank x y pieceSquareValue	= MkPieceSquareByCoordinatesByRank {-	deconstruct	:: Attribute.Rank.ArrayByRank (EitherPieceSquareValueByNPiecesByCoordinates x y pieceSquareValue)+newtype PieceSquareByCoordinatesByRank pieceSquareValue	= MkPieceSquareByCoordinatesByRank {+	deconstruct	:: Attribute.Rank.ArrayByRank (EitherPieceSquareValueByNPiecesByCoordinates pieceSquareValue) } deriving (Eq, Show) -instance (-	Control.DeepSeq.NFData	pieceSquareValue,-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y- ) => Control.DeepSeq.NFData (PieceSquareByCoordinatesByRank x y pieceSquareValue) where+instance Control.DeepSeq.NFData pieceSquareValue => Control.DeepSeq.NFData (PieceSquareByCoordinatesByRank pieceSquareValue) where 	rnf MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= Control.DeepSeq.rnf byRank  -- | Constructor. mkPieceSquareByCoordinatesByRank-	:: (Attribute.Rank.Rank -> EitherPieceSquareValueByNPiecesByCoordinates x y pieceSquareValue)	-- ^ Convert a /rank/ into either (a /pieceSquareValue/ or a /pieceSquareValue/ which linearly varies with the number of /piece/s remaining) by /coordinates/.-	-> PieceSquareByCoordinatesByRank x y pieceSquareValue+	:: (Attribute.Rank.Rank -> EitherPieceSquareValueByNPiecesByCoordinates pieceSquareValue)	-- ^ Convert a /rank/ into either (a /pieceSquareValue/ or a /pieceSquareValue/ which linearly varies with the number of /piece/s remaining) by /coordinates/.+	-> PieceSquareByCoordinatesByRank pieceSquareValue mkPieceSquareByCoordinatesByRank	= MkPieceSquareByCoordinatesByRank . Attribute.Rank.listArrayByRank . (`map` Property.FixedMembership.members) --- | The type of a function which can find the required piece-square value.-type FindPieceSquareValue x y pieceSquareValue-	= Attribute.LogicalColour.LogicalColour		-- ^ The /piece/'s /logical colour/.-	-> Attribute.Rank.Rank				-- ^ The /piece/'s /rank/.-	-> Cartesian.Coordinates.Coordinates x y	-- ^ The /piece/'s location.-	-> pieceSquareValue- -- | Find the piece-square value, at a stage in the game's lifetime defined by the total number of pieces remaining, for the specified /rank/ & /coordinates/.-findPieceSquareValue :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> Type.Count.NPieces				-- ^ The progress through the game.+findPieceSquareValue+	:: PieceSquareByCoordinatesByRank pieceSquareValue+	-> Type.Count.NPieces				-- ^ The progress through the game. 	-> Attribute.LogicalColour.LogicalColour	-- ^ The /piece/'s /logical colour/. 	-> Attribute.Rank.Rank				-- ^ The /piece/'s /rank/.-	-> Cartesian.Coordinates.Coordinates x y	-- ^ The /piece/'s location.-	-> PieceSquareByCoordinatesByRank x y pieceSquareValue+	-> Cartesian.Coordinates.Coordinates		-- ^ The /piece/'s location. 	-> pieceSquareValue-{-# SPECIALISE findPieceSquareValue-	:: Type.Count.NPieces-	-> Attribute.LogicalColour.LogicalColour-	-> Attribute.Rank.Rank-	-> Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y-	-> PieceSquareByCoordinatesByRank Type.Length.X Type.Length.Y Type.Mass.PieceSquareValue-	-> Type.Mass.PieceSquareValue- #-}-findPieceSquareValue nPieces logicalColour rank coordinates MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= (-	(!) ||| (-		\byNPiecesByCoordinates	-> (! nPieces) . (byNPiecesByCoordinates !)-	) $ byRank ! rank- ) $ (-	if Attribute.LogicalColour.isBlack logicalColour-		then Property.Reflectable.reflectOnX-		else id- ) coordinates---- | The type of a function which can find the required piece-square values.-type FindPieceSquareValues x y pieceSquareValue-	= Attribute.LogicalColour.LogicalColour		-- ^ The /piece/'s /logical colour/.-	-> Attribute.Rank.Rank				-- ^ The /piece/'s /rank/.-	-> [Cartesian.Coordinates.Coordinates x y]	-- ^ The locations of interest for the /piece/.-	-> [pieceSquareValue]---- | Find the piece-square values, at a stage in the game's lifetime defined by the total number of pieces remaining, for the specified /rank/ & list of /coordinates/.-findPieceSquareValues :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> Type.Count.NPieces				-- ^ The progress through the game.-	-> Attribute.LogicalColour.LogicalColour	-- ^ The /piece/'s /logical colour/.-	-> Attribute.Rank.Rank				-- ^ The /piece/'s /rank/.-	-> [Cartesian.Coordinates.Coordinates x y]	-- ^ The locations of interest for the specified /piece/.-	-> PieceSquareByCoordinatesByRank x y pieceSquareValue-	-> [pieceSquareValue]-{-# SPECIALISE findPieceSquareValues-	:: Type.Count.NPieces-	-> Attribute.LogicalColour.LogicalColour-	-> Attribute.Rank.Rank-	-> [Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y]-	-> PieceSquareByCoordinatesByRank Type.Length.X Type.Length.Y Type.Mass.PieceSquareValue-	-> [Type.Mass.PieceSquareValue]- #-}-findPieceSquareValues nPieces logicalColour rank coordinatesList MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= (+findPieceSquareValue MkPieceSquareByCoordinatesByRank { deconstruct = byRank } nPieces logicalColour rank	= ( 	(!) ||| ( 		\byNPiecesByCoordinates	-> (! nPieces) . (byNPiecesByCoordinates !) 	) $ byRank ! rank- ) `map` (-	if Attribute.LogicalColour.isBlack logicalColour-		then map Property.Reflectable.reflectOnX-		else id- ) coordinatesList+ ) . if Attribute.LogicalColour.isBlack logicalColour+	then Property.Reflectable.reflectOnX+	else id  -- | Given the bounds over which two piece-square values vary as the game progresses from opening to end, return linearly interpolated values for all stages. interpolatePieceSquareValues@@ -197,16 +129,11 @@ gnuPlotComment	= '#'  -- | Format the data for input to __GNUPlot__.-formatForGNUPlot :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> (pieceSquareValue -> ShowS)						-- ^ Format a /pieceSquareValue/.+formatForGNUPlot+	:: (pieceSquareValue -> ShowS)						-- ^ Format a /pieceSquareValue/. 	-> ShowS								-- ^ The column-delimiter. 	-> (PieceSquareValueByNPieces pieceSquareValue -> pieceSquareValue)	-- ^ Select one /pieceSquareValue/ from interpolated values.-	-> PieceSquareByCoordinatesByRank x y pieceSquareValue+	-> PieceSquareByCoordinatesByRank pieceSquareValue 	-> ShowS formatForGNUPlot pieceSquareValueFormatter columnDelimiter selector MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= ( 	showsRow (@@ -223,10 +150,10 @@ 			else id 	) . showS  ) id . zip (-	Property.FixedMembership.members	:: [Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y]+	Property.FixedMembership.members	:: [Cartesian.Coordinates.Coordinates]  ) . Data.List.transpose . map (-	Data.Array.IArray.elems ||| map selector {-select one pieceSquareValue from interpolated values-} . Data.Array.IArray.elems {-ByCoordinates-}- ) $ Data.Array.IArray.elems {-ByRank-} byRank where+	Data.Foldable.toList ||| map selector {-select one pieceSquareValue from interpolated values-} . Data.Foldable.toList {-ByCoordinates-}+ ) $ Data.Foldable.toList {-ByRank-} byRank where 	terminateRow	= showChar '\n' 	showsRow	= Text.ShowList.showsDelimitedList columnDelimiter id terminateRow 

@@ -42,37 +42,30 @@ import qualified	Control.DeepSeq  -- | A move qualified by its /movetype/.-data QualifiedMove x y	= MkQualifiedMove {-	getMove		:: Component.Move.Move x y,+data QualifiedMove	= MkQualifiedMove {+	getMove		:: Component.Move.Move, 	getMoveType	:: Attribute.MoveType.MoveType } deriving Eq -instance (Show x, Show y) => Show (QualifiedMove x y) where+instance Show QualifiedMove where 	showsPrec precedence MkQualifiedMove { 		getMove		= move, 		getMoveType	= moveType 	} = showsPrec precedence (move, moveType) -instance (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Read	x,-	Read	y- ) => Read (QualifiedMove x y) where+instance Read QualifiedMove where 	readsPrec precedence	= map (Control.Arrow.first $ uncurry MkQualifiedMove) . readsPrec precedence -instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (QualifiedMove x y) where+instance Control.DeepSeq.NFData QualifiedMove where 	rnf MkQualifiedMove { 		getMove		= move, 		getMoveType	= moveType 	} = Control.DeepSeq.rnf (move, moveType) -instance Enum y => Property.Reflectable.ReflectableOnX (QualifiedMove x y) where+instance Property.Reflectable.ReflectableOnX QualifiedMove where 	reflectOnX qualifiedMove@MkQualifiedMove { getMove = move }	= qualifiedMove { getMove = Property.Reflectable.reflectOnX move }  -- | Constructor.-mkQualifiedMove	:: Component.Move.Move x y -> Attribute.MoveType.MoveType -> QualifiedMove x y+mkQualifiedMove	:: Component.Move.Move -> Attribute.MoveType.MoveType -> QualifiedMove mkQualifiedMove	= MkQualifiedMove 

@@ -58,13 +58,13 @@  	* Additional data is recorded to facilitate both rollback & recording of the /move/ in various conventional notations. -}-data Turn x y	= MkTurn {-	getQualifiedMove	:: Component.QualifiedMove.QualifiedMove x y,+data Turn	= MkTurn {+	getQualifiedMove	:: Component.QualifiedMove.QualifiedMove, 	getRank			:: Attribute.Rank.Rank,	-- ^ The /rank/ of /piece/ that was moved, prior to any promotion. 	getIsRepeatableMove	:: Bool			-- ^ Whether this move can ever recur; without rolling-back. } -instance (Eq x, Eq y) => Eq (Turn x y) where+instance Eq Turn where 	MkTurn { 		getQualifiedMove	= qualifiedMove, 		getRank			= rank@@ -73,14 +73,14 @@ 		getRank			= rank' 	} = (qualifiedMove, rank) == (qualifiedMove', rank')	-- 'getIsRepeatableMove' can be derived. -instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Turn x y) where+instance Control.DeepSeq.NFData Turn where 	rnf MkTurn { 		getQualifiedMove	= qualifiedMove, 		getRank			= rank, 		getIsRepeatableMove	= isRepeatableMove 	} = Control.DeepSeq.rnf (qualifiedMove, rank, isRepeatableMove) -instance (Show x, Show y) => Show (Turn x y) where+instance Show Turn where 	showsPrec precedence MkTurn { 		getQualifiedMove	= qualifiedMove, 		getRank			= rank@@ -91,24 +91,17 @@ --		isRepeatableMove	-- Derived. 	 ) -- Represent as a tuple. -instance (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Read	x,-	Read	y- ) => Read (Turn x y) where+instance Read Turn where 	readsPrec precedence	= map (Control.Arrow.first $ uncurry mkTurn) . readsPrec precedence -instance Enum y => Property.Reflectable.ReflectableOnX (Turn x y) where+instance Property.Reflectable.ReflectableOnX Turn where 	reflectOnX turn@MkTurn { getQualifiedMove = qualifiedMove } = turn { getQualifiedMove = Property.Reflectable.reflectOnX qualifiedMove }  -- | Smart constructor. mkTurn-	:: Component.QualifiedMove.QualifiedMove x y+	:: Component.QualifiedMove.QualifiedMove 	-> Attribute.Rank.Rank-	-> Turn x y+	-> Turn mkTurn qualifiedMove rank = MkTurn { 	getQualifiedMove	= qualifiedMove, 	getRank			= rank,@@ -118,17 +111,13 @@ }  -- | Convenience.-isCapture :: Turn x y -> Bool+isCapture :: Turn -> Bool isCapture MkTurn { getQualifiedMove = qualifiedMove }	= Attribute.MoveType.isCapture $ Component.QualifiedMove.getMoveType qualifiedMove  -- | Whether the /turn/ represents a @Pawn@'s initial two-square advance.-isPawnDoubleAdvance :: (-	Enum	x,-	Enum	y,-	Eq	y- )-	=> Attribute.LogicalColour.LogicalColour	-- Defines the side whose /turn/ is referenced.-	-> Turn x y+isPawnDoubleAdvance+	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side whose /turn/ is referenced.+	-> Turn 	-> Bool isPawnDoubleAdvance logicalColour MkTurn { 	getRank			= Attribute.Rank.Pawn,@@ -139,8 +128,8 @@ -- | Forwards the request to 'Attribute.Rank.compareByLVA'. compareByLVA 	:: Attribute.Rank.EvaluateRank-	-> Turn x y-	-> Turn x y+	-> Turn+	-> Turn 	-> Ordering compareByLVA evaluateRank MkTurn { getRank = rankL } MkTurn { getRank = rankR }	= Attribute.Rank.compareByLVA evaluateRank rankL rankR @@ -155,8 +144,8 @@ -} compareByMVVLVA 	:: Attribute.Rank.EvaluateRank-	-> Turn x y-	-> Turn x y+	-> Turn+	-> Turn 	-> Ordering compareByMVVLVA evaluateRank turnL@MkTurn { 	getQualifiedMove	= qualifiedMoveL

@@ -1,4 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -30,9 +29,6 @@ -}  module BishBosh.Component.Zobrist(--- * Type-classes-	Hashable1D(..),-	Hashable2D(..), -- * Types -- ** Type-synonyms --	Index,@@ -44,15 +40,11 @@ --		getRandomByCastleableRooksXByLogicalColour, --		getRandomByEnPassantAbscissa 	),--- * Constants---	combiningOp, -- * Functions --	measureHammingDistances, 	dereferenceRandomByCoordinatesByRankByLogicalColour, 	dereferenceRandomByCastleableRooksXByLogicalColour, 	dereferenceRandomByEnPassantAbscissa,-	hash2D,-	combine, -- ** Constructors 	mkZobrist ) where@@ -64,28 +56,28 @@ import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates import qualified	BishBosh.Data.Exception			as Data.Exception+import qualified	BishBosh.Type.Length			as Type.Length import qualified	Control.Exception import qualified	Data.Array.IArray import qualified	Data.Bits import qualified	Data.Default import qualified	Data.Foldable-import qualified	Data.List import qualified	System.Random import qualified	ToolShed.System.Random  -- | Used as an index into 'getRandomByCoordinatesByRankByLogicalColour'.-type Index x y	= (Attribute.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates x y)+type Index	= (Attribute.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates)  -- | The random numbers used to generate a hash, which almost uniquely represent a /position/.-data Zobrist x y positionHash	= MkZobrist {-	getRandomForBlacksMove				:: positionHash,							-- ^ Defines a random number to apply when the next move is @Black@'s.-	getRandomByCoordinatesByRankByLogicalColour	:: Data.Array.IArray.Array {-Boxed-} (Index x y) positionHash,		-- ^ Defines random numbers to represent all combinations of each piece at each coordinate; though @Pawn@s can't exist on the terminal ranks. N.B.: regrettably the array can't be unboxed, because 'Data.Array.Unboxed.UArray' isn't 'Foldable'; cf. 'Data.Array.IArray.Array'.+data Zobrist positionHash	= MkZobrist {+	getRandomForBlacksMove				:: positionHash,									-- ^ Defines a random number to apply when the next move is @Black@'s.+	getRandomByCoordinatesByRankByLogicalColour	:: Data.Array.IArray.Array {-Boxed-} Index positionHash,				-- ^ Defines random numbers to represent all combinations of each piece at each coordinate; though @Pawn@s can't exist on the terminal ranks. N.B.: regrettably the array can't be unboxed, because 'Data.Array.Unboxed.UArray' isn't 'Foldable'; cf. 'Data.Array.IArray.Array'. -	getRandomByCastleableRooksXByLogicalColour	:: Attribute.LogicalColour.ArrayByLogicalColour [(x, positionHash)],	-- ^ Defines random numbers to represent all combinations of castleable @Rook@s.-	getRandomByEnPassantAbscissa			:: Cartesian.Abscissa.ArrayByAbscissa x positionHash			-- ^ Defines random numbers to represent any file on which capture en-passant might be available.+	getRandomByCastleableRooksXByLogicalColour	:: Attribute.LogicalColour.ArrayByLogicalColour [(Type.Length.X, positionHash)],	-- ^ Defines random numbers to represent all combinations of castleable @Rook@s.+	getRandomByEnPassantAbscissa			:: Data.Array.IArray.Array Type.Length.X positionHash					-- ^ Defines random numbers to represent any file on which capture en-passant might be available. } deriving Show -instance Foldable (Zobrist x y) where+instance Foldable Zobrist where 	foldr f i MkZobrist { 		getRandomForBlacksMove				= randomForBlacksMove, 		getRandomByCoordinatesByRankByLogicalColour	= randomByCoordinatesByRankByLogicalColour,@@ -102,13 +94,9 @@ 	 ) randomByEnPassantAbscissa  instance (-	Data.Array.IArray.Ix	x, 	Data.Bits.FiniteBits	positionHash,-	Enum			x,-	Enum			y,-	Ord			y, 	System.Random.Random	positionHash- ) => Data.Default.Default (Zobrist x y positionHash) where+ ) => Data.Default.Default (Zobrist positionHash) where 	def	= mkZobrist Nothing $ System.Random.mkStdGen 0  {- |@@ -118,7 +106,7 @@  	* CAVEAT: <https://en.wikipedia.org/wiki/Linear_independence> a better measure of the suitability of the selected random numbers -}-measureHammingDistances :: Data.Bits.Bits positionHash => Zobrist x y positionHash -> [Int]+measureHammingDistances :: Data.Bits.Bits positionHash => Zobrist positionHash -> [Int] measureHammingDistances	= map (Data.Bits.popCount . uncurry Data.Bits.xor) . getCombinations . Data.Foldable.toList where 	getCombinations :: [a] -> [(a, a)] 	getCombinations (x : remainder)	= map ((,) x) remainder ++ getCombinations remainder	-- CAVEAT: O(n^2) time-complexity.@@ -126,17 +114,13 @@  -- | Smart constructor. mkZobrist :: (-	Data.Array.IArray.Ix	x, 	Data.Bits.FiniteBits	positionHash,-	Enum			x,-	Enum			y,-	Ord			y, 	System.Random.RandomGen randomGen, 	System.Random.Random	positionHash  ) 	=> Maybe Int	-- ^ The optional minimum acceptable Hamming-distance between any two of the selected random numbers. 	-> randomGen-	-> Zobrist x y positionHash+	-> Zobrist positionHash mkZobrist maybeMinimumHammingDistance randomGen 	| Just minimumHammingDistance <- maybeMinimumHammingDistance 	, let minimumHammingDistance'	= minimum $ measureHammingDistances zobrist@@ -163,57 +147,18 @@ 		}  -- | Dereferences 'getRandomByCoordinatesByRankByLogicalColour' using the specified index.-dereferenceRandomByCoordinatesByRankByLogicalColour :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y- )-	=> Index x y-	-> Zobrist x y positionHash-	-> positionHash+dereferenceRandomByCoordinatesByRankByLogicalColour :: Index -> Zobrist positionHash -> positionHash dereferenceRandomByCoordinatesByRankByLogicalColour index MkZobrist { getRandomByCoordinatesByRankByLogicalColour = randomByCoordinatesByRankByLogicalColour }	= randomByCoordinatesByRankByLogicalColour ! index  -- | Dereferences 'getRandomByCastleableRooksXByLogicalColour' using the specified abscissa. dereferenceRandomByCastleableRooksXByLogicalColour-	:: Eq x-	=> Attribute.LogicalColour.LogicalColour-	-> x-	-> Zobrist x y positionHash+	:: Attribute.LogicalColour.LogicalColour+	-> Type.Length.X+	-> Zobrist positionHash 	-> Maybe positionHash	-- ^ The existence of a result depends on whether there remain any Rooks which can castle. dereferenceRandomByCastleableRooksXByLogicalColour logicalColour x MkZobrist { getRandomByCastleableRooksXByLogicalColour = randomByCastleableRooksXByLogicalColour }	= lookup x $ randomByCastleableRooksXByLogicalColour ! logicalColour  -- | Dereferences 'getRandomByEnPassantAbscissa' using the specified abscissa.-dereferenceRandomByEnPassantAbscissa-	:: Data.Array.IArray.Ix x-	=> x-	-> Zobrist x y positionHash-	-> positionHash+dereferenceRandomByEnPassantAbscissa :: Type.Length.X -> Zobrist positionHash -> positionHash dereferenceRandomByEnPassantAbscissa x MkZobrist { getRandomByEnPassantAbscissa = randomByEnPassantAbscissa }	= randomByEnPassantAbscissa ! x---- | An interface to which 1-D hashable data can conform.-class Hashable1D hashable x {-CAVEAT: MultiParamTypeClasses-} where-	listRandoms1D	:: hashable x -> Zobrist x y positionHash -> [positionHash]---- | An interface to which 2-D hashable data can conform.-class Hashable2D hashable x y {-CAVEAT: MultiParamTypeClasses-} where-	listRandoms2D	:: hashable x y -> Zobrist x y positionHash -> [positionHash]---- | The operator used when combining random numbers to compose a hash.-combiningOp :: Data.Bits.Bits positionHash => positionHash -> positionHash -> positionHash-combiningOp	= Data.Bits.xor---- | Resolve a hashable into a hash.-hash2D :: (-	Data.Bits.Bits	positionHash,-	Hashable2D	hashable x y- )-	=> hashable x y-	-> Zobrist x y positionHash-	-> positionHash-hash2D hashable	= Data.List.foldl1' combiningOp . listRandoms2D hashable---- | Include a list of random numbers in the hash.-combine :: Data.Bits.Bits positionHash => positionHash -> [positionHash] -> positionHash-combine	= Data.List.foldl' combiningOp 

@@ -68,9 +68,7 @@ 	parser, -- ** Constructors 	mkPGN,-	mkPGN',--- ** Mutators-	setGame+	mkPGN'  ) where  import			Control.Arrow((&&&), (***))@@ -85,7 +83,6 @@ import qualified	BishBosh.State.TurnsByLogicalColour		as State.TurnsByLogicalColour import qualified	BishBosh.Text.ShowList				as Text.ShowList import qualified	BishBosh.Type.Count				as Type.Count-import qualified	BishBosh.Type.Length				as Type.Length import qualified	Control.Applicative import qualified	Control.Arrow import qualified	Control.DeepSeq@@ -93,7 +90,7 @@ import qualified	Data.Char import qualified	Data.Default import qualified	Data.List-import qualified	Data.Map+import qualified	Data.Map					as Map import qualified	Data.Maybe import qualified	Data.Time.Calendar import qualified	Data.Time.Clock@@ -101,11 +98,13 @@  #ifdef USE_POLYPARSE import qualified	BishBosh.Text.Poly				as Text.Poly-#if USE_POLYPARSE == 1+#	if USE_POLYPARSE == 'L' import qualified	Text.ParserCombinators.Poly.Lazy		as Poly-#else /* Plain */+#	elif USE_POLYPARSE == 'P' import qualified	Text.ParserCombinators.Poly.Plain		as Poly-#endif+#	else+#		error "USE_POLYPARSE invalid"+#	endif #else /* Parsec */ import qualified	BishBosh.Data.Integral				as Data.Integral import qualified	Text.ParserCombinators.Parsec			as Parsec@@ -196,7 +195,7 @@ 	* The first six fields are mandatory according to the PGN-specification, though none are used by this application. 	The seventh mandatory field /Result/ can be derived from 'getGame'. -}-data PGN x y	= MkPGN {+data PGN	= MkPGN { 	getMaybeEventName		:: Maybe Value, 	getMaybeSiteName		:: Maybe Value, 	getDay				:: Data.Time.Calendar.Day,@@ -204,18 +203,10 @@ 	getMaybeWhitePlayerName		:: Maybe Value, 	getMaybeBlackPlayerName		:: Maybe Value, 	getIdentificationTagPairs	:: [TagPair],		-- ^ Arbitrary tagged values.-	getGame				:: Model.Game.Game x y	-- ^ Defines the turn-sequence & the result.+	getGame				:: Model.Game.Game	-- ^ Defines the turn-sequence & the result. } deriving Eq -instance (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- ) => Show (PGN x y) where-	{-# SPECIALISE instance Show (PGN Type.Length.X Type.Length.Y) #-}+instance Show PGN where 	showsPrec _ MkPGN { 		getMaybeEventName		= maybeEventName, 		getMaybeSiteName		= maybeSiteName,@@ -254,10 +245,7 @@ 		representUnknownTagValue :: Maybe Value -> ShowS 		representUnknownTagValue	= quote . Data.Maybe.maybe (showChar unknownTagValue) showString -instance (-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y- ) => Control.DeepSeq.NFData (PGN x y) where+instance Control.DeepSeq.NFData PGN where 	rnf MkPGN { 		getIdentificationTagPairs	= identificationTagPairs, 		getGame				= game@@ -272,8 +260,8 @@ 	-> Maybe Value	-- ^ Name of White player. 	-> Maybe Value	-- ^ Name of Black player. 	-> [TagPair]	-- ^ Arbitrary tag-pairs.-	-> Model.Game.Game x y-	-> PGN x y+	-> Model.Game.Game+	-> PGN mkPGN maybeEventName maybeSiteName day maybeRoundName maybeWhitePlayerName maybeBlackPlayerName identificationTagPairs game 	| any ( 		(== [unknownTagValue]) . snd {-tag-value-}@@ -304,16 +292,12 @@ 				 ] -- Those tags for which an unknown value is represented by 'unknownTagValue'. 		 ] -- List-comprehension. --- | Mutator.-setGame :: Model.Game.Game x y -> PGN x y -> PGN x y-setGame game pgn	= pgn { getGame = game }- -- | Smart constructor. mkPGN' 	:: [Tag]	-- ^ Identify fields used to form a unique composite game-identifier. 	-> [TagPair]	-- ^ The data from which to extract the required values.-	-> Model.Game.Game x y-	-> PGN x y+	-> Model.Game.Game+	-> PGN mkPGN' identificationTags tagPairs	= mkPGN maybeEventName maybeSiteName ( 	let #ifdef USE_POLYPARSE@@ -325,11 +309,11 @@ 	in Data.Maybe.maybe ( 		Control.Exception.throw . Data.Exception.mkSearchFailure . showString "failed to find " $ show dateTag	-- N.B.: this will only terminate the application when the date is evaluated. 	) (-#if USE_POLYPARSE != 1+#	if USE_POLYPARSE != 'L' 		either ( 			Control.Exception.throw . Data.Exception.mkParseFailure . showString "failed to parse " . shows dateTag . showString "; " . show 		) id .-#endif+#	endif 		fst . Poly.runParser dateParser #else /* Parsec */ 		dateParser :: Parsec.Parser Data.Time.Calendar.Day@@ -349,7 +333,7 @@ 	(`elem` identificationTags) . fst {-tag-}  ) tagPairs where 	[maybeEventName, maybeSiteName, maybeDate, maybeRoundName, maybeWhitePlayerName, maybeBlackPlayerName]	= map (-		`Data.Map.lookup` Data.Map.fromList tagPairs+		`Map.lookup` Map.fromList tagPairs 	 ) [ 		eventNameTag, 		siteNameTag,@@ -364,15 +348,7 @@  	* This function is only responsible for the line defining the numbered sequence of /move/s represented in SAN. -}-showsMoveText :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- ) => Model.Game.Game x y -> ShowS-{-# SPECIALISE showsMoveText :: Model.Game.Game Type.Length.X Type.Length.Y -> ShowS #-}+showsMoveText :: Model.Game.Game -> ShowS showsMoveText game	= foldr (.) ( 	Data.Maybe.maybe ( 		showsBlockComment "Game unfinished" . showChar ' ' . showChar inProgressFlag@@ -408,15 +384,7 @@ 	showsBlockComment	= shows . ContextualNotation.PGNComment.BlockComment  -- | Shows PGN for the specified /game/, with defaults for other fields.-showsGame :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- ) => Model.Game.Game x y -> IO ShowS-{-# SPECIALISE showsGame :: Model.Game.Game Type.Length.X Type.Length.Y -> IO ShowS #-}+showsGame :: Model.Game.Game -> IO ShowS showsGame game	= do 	utcTime	<- Data.Time.Clock.getCurrentTime @@ -495,28 +463,13 @@ #endif  -- | Parses a /game/ from PGN move-text.-moveTextParser :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- )+moveTextParser #ifdef USE_POLYPARSE-	=> IsStrictlySequential+	:: IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves-	-> Text.Poly.TextParser (Model.Game.Game x y)-{-# SPECIALISE moveTextParser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> Text.Poly.TextParser (Model.Game.Game Type.Length.X Type.Length.Y) #-}+	-> Text.Poly.TextParser Model.Game.Game moveTextParser isStrictlySequential validateMoves	= let-	elementSequenceParser :: (-		Enum	x,-		Enum	y,-		Ord	x,-		Ord	y,-		Show	x,-		Show	y-	 ) => Model.Game.Game x y -> Text.Poly.TextParser (Model.Game.Game x y)+	elementSequenceParser :: Model.Game.Game -> Text.Poly.TextParser Model.Game.Game 	elementSequenceParser game	= let 		expectedMoveNumber :: Type.Count.NMoves 		expectedMoveNumber	= fromIntegral . succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game@@ -551,19 +504,11 @@  in do 	game	<- fmap (Data.Maybe.fromMaybe Data.Default.def {-game-}) . Control.Applicative.optional $ elementSequenceParser Data.Default.def {-game-} #else /* Parsec */-	=> IsStrictlySequential+	:: IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves-	-> Parsec.Parser (Model.Game.Game x y)-{-# SPECIALISE moveTextParser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> Parsec.Parser (Model.Game.Game Type.Length.X Type.Length.Y) #-}+	-> Parsec.Parser Model.Game.Game moveTextParser isStrictlySequential validateMoves	= let-	elementSequenceParser :: (-		Enum	x,-		Enum	y,-		Ord	x,-		Ord	y,-		Show	x,-		Show	y-	 ) => Model.Game.Game x y -> Parsec.Parser (Model.Game.Game x y)+	elementSequenceParser :: Model.Game.Game -> Parsec.Parser Model.Game.Game 	elementSequenceParser game	= let 		expectedMoveNumber :: Type.Count.NMoves 		expectedMoveNumber	= fromIntegral . succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game@@ -603,25 +548,17 @@ 	* CAVEAT: this function doesn't /produce/ when using either "Parsec" or "Poly.Plain", since it returns 'Either' the appropriate constructor for which may be unknown until the last character is parsed. 	Equally for these parsers, all data must be strictly evaluated before any data can retrieved. -}-parser :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- )-	=> IsStrictlySequential+parser+	:: IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves 	-> [Tag]	-- ^ Identify fields used to form a unique composite game-identifier. #ifdef USE_POLYPARSE-	-> Text.Poly.TextParser (PGN x y)-{-# SPECIALISE parser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [Tag] -> Text.Poly.TextParser (PGN Type.Length.X Type.Length.Y) #-}+	-> Text.Poly.TextParser PGN parser isStrictlySequential validateMoves identificationTags	= do 	tagPairs	<- Control.Applicative.many $ tagPairParser <* Control.Applicative.many ContextualNotation.PGNComment.parser-	moveText	<- moveTextParser' <* Control.Applicative.many ContextualNotation.PGNComment.parser+	game		<- moveTextParser' <* Control.Applicative.many ContextualNotation.PGNComment.parser -	return {-to Parser-monad-} $ mkPGN' identificationTags (removeUnknownTagValues tagPairs) moveText+	return {-to Parser-monad-} $ mkPGN' identificationTags (removeUnknownTagValues tagPairs) game  	where 		tagPairParser :: Text.Poly.TextParser TagPair@@ -643,8 +580,7 @@ 				return {-to Parser-monad-} (tagName, tagValue) 		 ) #else /* Parsec */-	-> Parsec.Parser (PGN x y)-{-# SPECIALISE parser :: IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [Tag] -> Parsec.Parser (PGN Type.Length.X Type.Length.Y) #-}+	-> Parsec.Parser PGN parser isStrictlySequential validateMoves identificationTags	= mkPGN' identificationTags <$> ( 	removeUnknownTagValues <$> Control.Applicative.many ( 		tagPairParser <* Control.Applicative.many ContextualNotation.PGNComment.parser

@@ -45,11 +45,13 @@  #ifdef USE_POLYPARSE import qualified	BishBosh.Text.Poly			as Text.Poly-#if USE_POLYPARSE == 1+#	if USE_POLYPARSE == 'L' import qualified	Text.ParserCombinators.Poly.Lazy	as Poly-#else /* Plain */+#	elif USE_POLYPARSE == 'P' import qualified	Text.ParserCombinators.Poly.Plain	as Poly-#endif+#	else+#		error "USE_POLYPARSE invalid"+#	endif #else /* Parsec */ import qualified	Control.Monad import qualified	Text.ParserCombinators.Parsec		as Parsec

@@ -47,7 +47,6 @@ import qualified	BishBosh.ContextualNotation.StandardAlgebraic	as ContextualNotation.StandardAlgebraic import qualified	BishBosh.Data.Exception				as Data.Exception import qualified	BishBosh.Type.Count				as Type.Count-import qualified	BishBosh.Type.Length				as Type.Length import qualified	Control.Exception import qualified	Control.Monad import qualified	Data.Maybe@@ -58,11 +57,13 @@  #ifdef USE_POLYPARSE import qualified	BishBosh.Text.Poly				as Text.Poly-#	if USE_POLYPARSE == 1+#	if USE_POLYPARSE == 'L' import qualified	Text.ParserCombinators.Poly.Lazy		as Poly-#	else /* Plain */+#	elif USE_POLYPARSE == 'P' import qualified	Control.Arrow import qualified	Text.ParserCombinators.Poly.Plain		as Poly+#	else+#		error "USE_POLYPARSE invalid" #	endif #else /* Parsec */ import qualified	Control.Arrow@@ -71,61 +72,46 @@ #endif  -- | Self-documentation.-type PGNDatabase x y	= [ContextualNotation.PGN.PGN x y]+type PGNDatabase	= [ContextualNotation.PGN.PGN]  -- | Parse a PGN-database.-parser :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- )-	=> ContextualNotation.PGN.IsStrictlySequential+parser+	:: ContextualNotation.PGN.IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves 	-> [ContextualNotation.PGN.Tag] #ifdef USE_POLYPARSE-	-> Text.Poly.TextParser (PGNDatabase x y)-{-# SPECIALISE parser :: ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [ContextualNotation.PGN.Tag] -> Text.Poly.TextParser (PGNDatabase Type.Length.X Type.Length.Y) #-}+	-> Text.Poly.TextParser PGNDatabase parser isStrictlySequential validateMoves identificationTags	= Poly.manyFinally' parser' $ Text.Poly.spaces >> Poly.eof #else /* Parsec */-	-> Parsec.Parser (PGNDatabase x y)-{-# SPECIALISE parser :: ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [ContextualNotation.PGN.Tag] -> Parsec.Parser (PGNDatabase Type.Length.X Type.Length.Y) #-}+	-> Parsec.Parser PGNDatabase parser isStrictlySequential validateMoves identificationTags	= Parsec.manyTill parser' (Parsec.try $ Parsec.spaces >> Parsec.try Parsec.eof)	<?> "PGN-database" #endif 	where 		parser'	= ContextualNotation.PGN.parser isStrictlySequential validateMoves identificationTags  -- | PGNPredicate used to filter the database.-type PGNPredicate x y	= ContextualNotation.PGN.PGN x y -> Bool+type PGNPredicate	= ContextualNotation.PGN.PGN -> Bool  -- | The optional maximum number of games to read. type MaybeMaximumGames	= Maybe Type.Count.NGames  -- | Parses a PGN-database from the specified string.-parse :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- )-	=> String		-- ^ The name of the specified database.+parse+	:: String		-- ^ The name of the specified database. 	-> ContextualNotation.PGN.IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves 	-> [ContextualNotation.PGN.Tag]-	-> PGNPredicate x y	-- ^ Used to filter entries from the database.+	-> PGNPredicate		-- ^ Used to filter entries from the database. 	-> MaybeMaximumGames	-- ^ Optional maximum number of games to read from the database (after they've been filtered). 	-> String		-- ^ The database-contents.-	-> Either String (PGNDatabase x y)-{-# SPECIALISE parse :: String -> ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> [ContextualNotation.PGN.Tag] -> PGNPredicate Type.Length.X Type.Length.Y -> MaybeMaximumGames -> String -> Either String (PGNDatabase Type.Length.X Type.Length.Y) #-}+	-> Either String PGNDatabase #ifdef USE_POLYPARSE-#	if USE_POLYPARSE == 1+#	if USE_POLYPARSE == 'L' parse _ isStrictlySequential validateMoves identificationTags pgnPredicate maybeMaximumGames	= Right	-- N.B.: the lazy parser throws an exception rather than returning 'Either', because otherwise it can't choose whether to construct with 'Left' or 'Right' until the input has been fully parsed.-#	else /* Plain */+#	elif USE_POLYPARSE == 'P' parse name isStrictlySequential validateMoves identificationTags pgnPredicate maybeMaximumGames	= Control.Arrow.left (showString "regarding " . shows name . showString ", ")+#	else+#		error "USE_POLYPARSE invalid" #	endif 	. fst {-discard unparsed data-} . Poly.runParser parser' #else /* Parsec */@@ -140,24 +126,16 @@ type Decompressor	= String  -- | Reads a PGN-database from the (optionally compressed) file-path & passes it to the parser.-parseIO :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- )-	=> System.FilePath.FilePath	-- ^ The PGN-file's location.+parseIO+	:: System.FilePath.FilePath	-- ^ The PGN-file's location. 	-> Maybe Decompressor		-- ^ An Optional executable by which to decompress the PGN-file. 	-> ContextualNotation.PGN.IsStrictlySequential 	-> ContextualNotation.StandardAlgebraic.ValidateMoves 	-> System.IO.TextEncoding	-- ^ The conversion-scheme between byte-sequences & Unicode characters. 	-> [ContextualNotation.PGN.Tag]-	-> PGNPredicate x y		-- ^ Used to filter entries from the database.+	-> PGNPredicate			-- ^ Used to filter entries from the database. 	-> MaybeMaximumGames		-- ^ Optional maximum number of games to read from the database (after they've been filtered).-	-> IO (Either String (PGNDatabase x y))-{-# SPECIALISE parseIO :: System.FilePath.FilePath -> Maybe Decompressor -> ContextualNotation.PGN.IsStrictlySequential -> ContextualNotation.StandardAlgebraic.ValidateMoves -> System.IO.TextEncoding -> [ContextualNotation.PGN.Tag] -> PGNPredicate Type.Length.X Type.Length.Y -> MaybeMaximumGames -> IO (Either String (PGNDatabase Type.Length.X Type.Length.Y)) #-}+	-> IO (Either String PGNDatabase) parseIO filePath maybeDecompressionCommand isStrictlySequential validateMoves textEncoding identificationTags pgnPredicate maybeMaximumGames	= parse filePath isStrictlySequential validateMoves identificationTags pgnPredicate maybeMaximumGames `fmap` Data.Maybe.maybe ( 	System.IO.withFile filePath System.IO.ReadMode $ \fileHandle -> do 		System.IO.hSetEncoding fileHandle textEncoding

@@ -27,8 +27,13 @@ -- * Types -- ** Type-synonyms --	Tree,-	OnymousQualifiedMove,+--	OnymousQualifiedMove, --	FindMatch,+	TryToMatchMoves,+	TryToMatchViaJoiningMove,+	TryToMatchColourFlippedPosition,+	PreferVictories,+	MatchSwitches, -- ** Data-types 	NodeLabel(), 	PositionHashQualifiedMoveTree(),@@ -38,6 +43,7 @@ 	findNextOnymousQualifiedMovesForPosition, --	findNextJoiningOnymousQualifiedMovesFromPosition, 	findNextOnymousQualifiedMoves,+--	shortListMostVictorious, 	maybeRandomlySelectOnymousQualifiedMove, -- ** Constructors 	fromQualifiedMoveForest,@@ -47,6 +53,7 @@  ) where  import			Control.Arrow((&&&), (***))+import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType import qualified	BishBosh.Component.Piece			as Component.Piece import qualified	BishBosh.Component.QualifiedMove		as Component.QualifiedMove@@ -57,64 +64,66 @@ import qualified	BishBosh.Property.Reflectable			as Property.Reflectable import qualified	BishBosh.Rule.Result				as Rule.Result import qualified	BishBosh.State.Board				as State.Board+import qualified	BishBosh.StateProperty.Censor			as StateProperty.Censor+import qualified	BishBosh.StateProperty.Hashable			as StateProperty.Hashable import qualified	BishBosh.Type.Count				as Type.Count import qualified	BishBosh.Type.Crypto				as Type.Crypto-import qualified	BishBosh.Type.Length				as Type.Length import qualified	Control.Arrow import qualified	Control.Exception-import qualified	Data.Array.IArray import qualified	Data.Bits import qualified	Data.Default+import qualified	Data.Foldable import qualified	Data.List import qualified	Data.List.Extra import qualified	Data.Maybe import qualified	Data.Tree-import qualified	Factory.Math.Statistics import qualified	System.Random import qualified	ToolShed.System.Random  #ifdef USE_PARALLEL-import qualified	Control.DeepSeq import qualified	Control.Parallel.Strategies #endif  -- | Each label of the tree contains a /Zobrist-hash/ of the current position, augmented (except in the case of the apex-game) by the last /move/ that was played, & any conclusive result.-data NodeLabel x y positionHash	= MkNodeLabel {+data NodeLabel positionHash	= MkNodeLabel { 	getPositionHash				:: positionHash,-	getMaybeQualifiedMoveWithOnymousResult	:: Maybe (Component.QualifiedMove.QualifiedMove x y, Maybe ContextualNotation.QualifiedMoveForest.OnymousResult)+	getMaybeQualifiedMoveWithOnymousResult	:: Maybe (Component.QualifiedMove.QualifiedMove, Maybe ContextualNotation.QualifiedMoveForest.OnymousResult) }  -- | The tree of /qualified move/s.-type Tree x y positionHash	= Data.Tree.Tree (NodeLabel x y positionHash)+type Tree positionHash	= Data.Tree.Tree (NodeLabel positionHash)  -- | Constructor.-data PositionHashQualifiedMoveTree x y positionHash	= MkPositionHashQualifiedMoveTree {-	getZobrist		:: Component.Zobrist.Zobrist x y positionHash,	-- ^ Used to hash each position in the tree.-	getTree			:: Tree x y positionHash,-	getMinimumPieces	:: Type.Count.NPieces				-- ^ The minimum number of /piece/s remaining after the last /move/ in any game defined in the tree.+data PositionHashQualifiedMoveTree positionHash	= MkPositionHashQualifiedMoveTree {+	getZobrist		:: Component.Zobrist.Zobrist positionHash,	-- ^ Used to hash each position in the tree.+	getTree			:: Tree positionHash,+	getMinimumPieces	:: ! Type.Count.NPieces,			-- ^ The minimum number of /piece/s remaining after the last /move/ in any game defined in the tree.+	getHasAnyVictories	:: Bool						-- ^ Whether a victory has been recorded for any game in the tree; which won't be the case if it was constructed from a PGN-database containing standard-openings. }  -- | Augment the specified /qualified-move forest/ with a /Zobrist-hash/ of the /position/ & include the default initial game at the apex.-fromQualifiedMoveForest :: (-	Data.Array.IArray.Ix	x,-	Data.Bits.Bits		positionHash,-	Enum			x,-	Enum			y,-	Ord			y,-	Show			x,-	Show			y- )+fromQualifiedMoveForest+	:: Data.Bits.Bits positionHash 	=> Bool	-- ^ IncrementalEvaluation.-	-> Component.Zobrist.Zobrist x y positionHash-	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest x y-	-> PositionHashQualifiedMoveTree x y positionHash-{-# SPECIALISE fromQualifiedMoveForest :: Bool -> Component.Zobrist.Zobrist Type.Length.X Type.Length.Y Type.Crypto.PositionHash -> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest Type.Length.X Type.Length.Y -> PositionHashQualifiedMoveTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash #-}+	-> Component.Zobrist.Zobrist positionHash+	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest+	-> PositionHashQualifiedMoveTree positionHash+{-# SPECIALISE fromQualifiedMoveForest :: Bool -> Component.Zobrist.Zobrist Type.Crypto.PositionHash -> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest -> PositionHashQualifiedMoveTree Type.Crypto.PositionHash #-} fromQualifiedMoveForest incrementalEvaluation zobrist qualifiedMoveForest	= MkPositionHashQualifiedMoveTree { 	getZobrist		= zobrist,-	getTree			= let-		initialGame		= Data.Default.def-		initialPositionHash	= Component.Zobrist.hash2D initialGame zobrist-	in Data.Tree.Node {+	getTree			= tree,+	getMinimumPieces	= ContextualNotation.QualifiedMoveForest.findMinimumPieces qualifiedMoveForest,+	getHasAnyVictories	= Data.Foldable.any (+		Data.Maybe.maybe False {-no QualifiedMove-} (+			Data.Maybe.maybe False {-no OnymousResult-} (+				not . Rule.Result.isDraw . snd {-Result-}+			) . snd {-Maybe OnymousResult-}+		) . getMaybeQualifiedMoveWithOnymousResult+	) tree+} where+	initialGame		= Data.Default.def+	initialPositionHash	= StateProperty.Hashable.hash initialGame zobrist+	tree			= Data.Tree.Node { 		Data.Tree.rootLabel	= MkNodeLabel initialPositionHash Nothing, 		Data.Tree.subForest	= map ( 			if incrementalEvaluation@@ -134,18 +143,16 @@ 						Data.Tree.rootLabel	= label@(qualifiedMove, _), 						Data.Tree.subForest	= qualifiedMoveForest' 					} = Data.Tree.Node {-						Data.Tree.rootLabel	= MkNodeLabel (Component.Zobrist.hash2D game' zobrist) $ Just label,	-- Hash the game after applying the move.+						Data.Tree.rootLabel	= MkNodeLabel (StateProperty.Hashable.hash game' zobrist) $ Just label,	-- Hash the game after applying the move. 						Data.Tree.subForest	= map (slave game') qualifiedMoveForest'	-- Recurse. 					} where 						game'	= Model.Game.applyQualifiedMove qualifiedMove game 				in slave initialGame 		) $ ContextualNotation.QualifiedMoveForest.deconstruct qualifiedMoveForest-	},-	getMinimumPieces	= ContextualNotation.QualifiedMoveForest.findMinimumPieces qualifiedMoveForest-}+	}  -- | Predicate.-isTerminal :: PositionHashQualifiedMoveTree x y positionHash -> Bool+isTerminal :: PositionHashQualifiedMoveTree positionHash -> Bool isTerminal MkPositionHashQualifiedMoveTree { getTree = Data.Tree.Node { Data.Tree.subForest = [] } }	= True isTerminal _												= False @@ -154,14 +161,14 @@  	* CAVEAT: a negative result doesn't imply that convergence is possible, since other factors may prevent it. -}-cantConverge :: Model.Game.Game x y -> PositionHashQualifiedMoveTree x y positionHash -> Bool+cantConverge :: Model.Game.Game -> PositionHashQualifiedMoveTree positionHash -> Bool cantConverge game MkPositionHashQualifiedMoveTree { getMinimumPieces = minimumPieces }	= State.Board.getNPieces (Model.Game.getBoard game) < minimumPieces  -- | A /qualified move/ annotated by the name & ultimate /result/, of each /game/ from which it could have originated.-type OnymousQualifiedMove x y	= (Component.QualifiedMove.QualifiedMove x y, [ContextualNotation.QualifiedMoveForest.OnymousResult])+type OnymousQualifiedMove	= (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.OnymousResult])  -- | Find the /onymous result/s for all /game/s originating from the specified tree.-onymiseQualifiedMove :: Tree x y positionHash -> OnymousQualifiedMove x y+onymiseQualifiedMove :: Tree positionHash -> OnymousQualifiedMove onymiseQualifiedMove	= ( 	fst {-qualifiedMove-} . head &&& Data.Maybe.mapMaybe snd {-Maybe OnymousResult-}  ) . (@@ -171,10 +178,10 @@  ) . Data.Tree.flatten  -- | The type of a function used to locate a match in the tree.-type FindMatch x y positionHash	= Model.Game.Game x y -> PositionHashQualifiedMoveTree x y positionHash -> [OnymousQualifiedMove x y]+type FindMatch positionHash	= Model.Game.Game -> PositionHashQualifiedMoveTree positionHash -> [OnymousQualifiedMove]  -- | For any exactly matching /game/ in the tree, return the subsequent /qualifiedMove/s.-findNextOnymousQualifiedMovesForGame :: (Eq x, Eq y) => FindMatch x y positionHash+findNextOnymousQualifiedMovesForGame :: FindMatch positionHash findNextOnymousQualifiedMovesForGame requiredGame	= slave ( 	Model.Game.listTurnsChronologically requiredGame  ) . Data.Tree.subForest {-remove the apex which lacks a founding move-} . getTree where@@ -192,59 +199,47 @@  	* By matching the /position/ rather than the precise sequence of /move/s, transpositions <https://www.chessprogramming.org/Transposition> can also be identified. +	* N.B.: a comparison between the number of pieces in the game we're required to match & the decreasing number of pieces down the tree, permits early termination of the search.+ 	* CAVEAT: a null list can result from either match-failure, or a match with the final /move/ of a /game/. -}-findNextOnymousQualifiedMovesForPosition :: (-	Data.Array.IArray.Ix	x,-	Data.Bits.Bits		positionHash,-	Enum			x,-	Enum			y,-	Ord			y- ) => FindMatch x y positionHash-{-# SPECIALISE findNextOnymousQualifiedMovesForPosition :: FindMatch Type.Length.X Type.Length.Y Type.Crypto.PositionHash #-}-findNextOnymousQualifiedMovesForPosition requiredGame positionHashQualifiedMoveTree@MkPositionHashQualifiedMoveTree {-	getZobrist	= zobrist,-	getTree		= tree-}-	| cantConverge requiredGame positionHashQualifiedMoveTree	= []	-- The specified game has fewer pieces than any defined in the tree.-	| otherwise							= slave (2 * Component.Piece.nPiecesPerSide) tree+findNextOnymousQualifiedMovesForPosition :: Data.Bits.Bits positionHash => FindMatch positionHash+{-# SPECIALISE findNextOnymousQualifiedMovesForPosition :: FindMatch Type.Crypto.PositionHash #-}+findNextOnymousQualifiedMovesForPosition requiredGame positionHashQualifiedMoveTree+	| cantConverge requiredGame positionHashQualifiedMoveTree	= []	-- The game we're required to match has fewer pieces than any defined in the tree.+	| otherwise							= slave nPiecesDiffByLogicalColour $ getTree positionHashQualifiedMoveTree 	where-		(requiredPositionHash, requiredNPieces)	= (`Component.Zobrist.hash2D` zobrist) &&& State.Board.getNPieces . Model.Game.getBoard $ requiredGame+		nPiecesDiffByLogicalColour :: (Type.Count.NPieces, Type.Count.NPieces)+		(requiredPositionHash, nPiecesDiffByLogicalColour)	= (`StateProperty.Hashable.hash` getZobrist positionHashQualifiedMoveTree) &&& (+			uncurry (***) . (id &&& id) $ (Component.Piece.nPiecesPerSide -)	-- Find the excess pieces on either side, to be taken before a match can be found.+		 ) . StateProperty.Censor.countPiecesByLogicalColour . State.Board.getCoordinatesByRankByLogicalColour . Model.Game.getBoard $ requiredGame -		slave nPieces Data.Tree.Node {+		slave (nPiecesDiffOpponent, nPiecesDiffMover) Data.Tree.Node { 			Data.Tree.rootLabel	= MkNodeLabel { getPositionHash = positionHash }, 			Data.Tree.subForest	= forest 		} = (-			if positionHash == requiredPositionHash-				then (-					map onymiseQualifiedMove forest ++	-- The position matches, so one can select any move from the forest.-				) -- Section.-				else id+			case nPiecesDiffMover `compare` 0 of	-- N.B. equivalent to 'signum' to slightly better performance.+				GT	-> id		-- This node can't match, but there may be a match further down the tree.+				EQ+					| positionHash == requiredPositionHash	-> (map onymiseQualifiedMove forest ++) -- The position matches, so one can select any move from the forest.+					| otherwise				-> id					-- This node doesn't match, but there may be a match further down the tree.+				_	-> const []	-- Terminate the recursion, since from here down the tree, the mover has insufficient pieces to match the required game. 		 ) $ concatMap ( 			\node@Data.Tree.Node { 				Data.Tree.rootLabel	= MkNodeLabel { getMaybeQualifiedMoveWithOnymousResult = Just (qualifiedMove, _) }-			} -> if Attribute.MoveType.isCapture $ Component.QualifiedMove.getMoveType qualifiedMove-				then if nPieces == requiredNPieces-					then []	-- Terminate the recursion; no further pieces can be lost if a match is to occur.-					else slave (pred nPieces) node	-- Recurse.-				else slave nPieces node	-- Recurse.+			} -> slave (+				nPiecesDiffMover,+				(+					if Attribute.MoveType.isCapture $! Component.QualifiedMove.getMoveType qualifiedMove+						then pred+						else id+				) nPiecesDiffOpponent+			) {-swap pair-} node	-- Recurse. 		 ) forest  -- | Finds any single /move/s which can join the current /position/ with a member of the forest.-findNextJoiningOnymousQualifiedMovesFromPosition :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y,-#endif-	Data.Array.IArray.Ix	x,-	Data.Bits.Bits		positionHash,-	Enum			x,-	Enum			y,-	Ord			y,-	Show			x,-	Show			y- ) => FindMatch x y positionHash-{-# SPECIALISE findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch Type.Length.X Type.Length.Y Type.Crypto.PositionHash #-}+findNextJoiningOnymousQualifiedMovesFromPosition :: Data.Bits.Bits positionHash => FindMatch positionHash+{-# SPECIALISE findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch Type.Crypto.PositionHash #-} findNextJoiningOnymousQualifiedMovesFromPosition game positionHashQualifiedMoveTree 	| Model.Game.isTerminated game	= [] 	| otherwise			= [@@ -260,6 +255,21 @@ 				) $ Model.Game.findQualifiedMovesAvailableToNextPlayer game 	] -- List-comprehension. +-- | Whether to attempt to exactly match moves with a standard opening; transpositions won't be matched.+type TryToMatchMoves	= Bool++-- | Whether to attempt to join the current position to a standard opening that's only one ply away.+type TryToMatchViaJoiningMove	= Bool++-- | Whether to attempt to match a colour-flipped version of the current position with a standard opening+type TryToMatchColourFlippedPosition	= Bool++-- | The switches used to control attempts to find a match amongst standard openings.+type MatchSwitches	= (TryToMatchMoves, TryToMatchViaJoiningMove, TryToMatchColourFlippedPosition)++-- | Whether from all matching positions extracted from the tree, to prefer moves which result in a greater probability of victory, for the player who has the next move.+type PreferVictories	= Bool+ {- | 	* Calls 'findNextOnymousQualifiedMovesForGame' to find an exact match for the current /game/ in the tree. @@ -273,22 +283,11 @@  	* CAVEAT: the order of these searches has been hard-coded. -}-findNextOnymousQualifiedMoves :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y,-#endif-	Data.Array.IArray.Ix	x,-	Data.Bits.Bits		positionHash,-	Enum			x,-	Enum			y,-	Ord			y,-	Show			x,-	Show			y- )-	=> (Bool, Bool, Bool)	-- ^ MatchSwitches.-	-> FindMatch x y positionHash-{-# SPECIALISE findNextOnymousQualifiedMoves :: (Bool, Bool, Bool) -> FindMatch Type.Length.X Type.Length.Y Type.Crypto.PositionHash #-}+findNextOnymousQualifiedMoves+	:: Data.Bits.Bits positionHash+	=> MatchSwitches+	-> FindMatch positionHash+{-# SPECIALISE findNextOnymousQualifiedMoves :: MatchSwitches -> FindMatch Type.Crypto.PositionHash #-} findNextOnymousQualifiedMoves (tryToMatchMoves, tryToMatchViaJoiningMove, tryToMatchColourFlippedPosition) game positionHashQualifiedMoveTree 	| cantConverge game positionHashQualifiedMoveTree	= []	-- The specified game is smaller than any defined in the tree. 	| otherwise						= Data.Maybe.fromMaybe [] . Data.List.find (@@ -311,49 +310,46 @@ 			] -- Transform an arbitrary match-function to operate on either the original or the colour-flipped game. 	] -- List-comprehension. +-- | Shortlist matching moves extracted from the tree, prefering those after which the player who makes it, has the greatest recorded incidence of victory.+shortListMostVictorious+	:: Attribute.LogicalColour.LogicalColour	-- ^ The player who is next to move.+	-> [OnymousQualifiedMove]+	-> [OnymousQualifiedMove]+shortListMostVictorious nextLogicalColour	= last {-highest scoring group-} . Data.List.Extra.groupSortOn (+	Data.List.foldl' (+		\acc -> ($ acc) . Data.Maybe.maybe id {-draw-} (+			\victorsLogicalColour -> if victorsLogicalColour == nextLogicalColour then succ else pred	-- Score the result, according to which side we'd like to win.+		) . Rule.Result.findMaybeVictor . snd {-result-}+	) (0 :: Int) . snd {-[OnymousResult]-}+ )+ -- | Randomly select a /qualifiedMove/ from matching /position/s in the tree, & supply the names of those archived games from which it originated. maybeRandomlySelectOnymousQualifiedMove :: (-#ifdef USE_PARALLEL-	Control.DeepSeq.NFData	x,-	Control.DeepSeq.NFData	y,-#endif-	Data.Array.IArray.Ix	x, 	Data.Bits.Bits		positionHash,-	Enum			x,-	Enum			y,-	Ord			y,-	Show			x,-	Show			y, 	System.Random.RandomGen	randomGen  ) 	=> randomGen-	-> (Bool, Bool, Bool)	-- ^ MatchSwitches.-	-> Model.Game.Game x y-	-> PositionHashQualifiedMoveTree x y positionHash-	-> Maybe (Component.QualifiedMove.QualifiedMove x y, [ContextualNotation.QualifiedMoveForest.Name])+	-> PreferVictories+	-> MatchSwitches+	-> Model.Game.Game+	-> PositionHashQualifiedMoveTree positionHash+	-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name]) {-# SPECIALISE maybeRandomlySelectOnymousQualifiedMove 	:: System.Random.RandomGen randomGen 	=> randomGen-	-> (Bool, Bool, Bool)-	-> Model.Game.Game Type.Length.X Type.Length.Y-	-> PositionHashQualifiedMoveTree Type.Length.X Type.Length.Y Type.Crypto.PositionHash-	-> Maybe (Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y, [ContextualNotation.QualifiedMoveForest.Name])+	-> PreferVictories+	-> MatchSwitches+	-> Model.Game.Game+	-> PositionHashQualifiedMoveTree Type.Crypto.PositionHash+	-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name])  #-}-maybeRandomlySelectOnymousQualifiedMove randomGen matchSwitches game positionHashQualifiedMoveTree	= case findNextOnymousQualifiedMoves matchSwitches game positionHashQualifiedMoveTree of+maybeRandomlySelectOnymousQualifiedMove randomGen preferVictories matchSwitches game positionHashQualifiedMoveTree	= case findNextOnymousQualifiedMoves matchSwitches game positionHashQualifiedMoveTree of 	[]			-> Nothing 	onymousQualifiedMoves	-> fmap ( 		Control.Arrow.second $ Data.List.nub . map fst {-Name-}-	 ) . ToolShed.System.Random.select randomGen . last {-highest scoring group-} $ Data.List.Extra.groupSortOn (-		(-			Factory.Math.Statistics.getMean	:: [Int] -> Rational-		) . map (-			 Data.Maybe.maybe 0 {-a draw-} (-				\victorsLogicalColour -> (-					if victorsLogicalColour == Model.Game.getNextLogicalColour game-						then id-						else negate-				) 1 {-victory-}-			) . Rule.Result.findMaybeVictor . snd {-result-}	-- Score the result, according to which side we'd like to win.-		) . snd {-[OnymousResult]-}+	 ) . ToolShed.System.Random.select randomGen $ (+		if preferVictories && getHasAnyVictories positionHashQualifiedMoveTree+			then shortListMostVictorious $ Model.Game.getNextLogicalColour game+			else id 	 ) onymousQualifiedMoves 

@@ -51,6 +51,7 @@ import			Control.Applicative((<|>)) import			Control.Arrow((&&&), (***)) import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType+import qualified	BishBosh.Component.Piece		as Component.Piece import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove import qualified	BishBosh.Component.Turn			as Component.Turn import qualified	BishBosh.ContextualNotation.PGN		as ContextualNotation.PGN@@ -63,10 +64,8 @@ import qualified	BishBosh.Property.Null			as Property.Null import qualified	BishBosh.Rule.GameTerminationReason	as Rule.GameTerminationReason import qualified	BishBosh.Rule.Result			as Rule.Result-import qualified	BishBosh.State.Board			as State.Board import qualified	BishBosh.Text.ShowList			as Text.ShowList import qualified	BishBosh.Type.Count			as Type.Count-import qualified	BishBosh.Type.Length			as Type.Length import qualified	Control.Arrow import qualified	Data.Default import qualified	Data.List@@ -88,7 +87,7 @@  	* CAVEAT: since zero moves have been made in the default initial game, the move-tree for the whole game of chess has no apex, so a forest is a more natural structure; though sub-trees can exist. -}-type QualifiedMoveTree x y	= Data.Tree.Tree (Component.QualifiedMove.QualifiedMove x y, Maybe OnymousResult)+type QualifiedMoveTree	= Data.Tree.Tree (Component.QualifiedMove.QualifiedMove, Maybe OnymousResult)  {- | 	* A representation of a PGN-database, where initial /move/s shared between /game/s are merged into the trunk of a tree from which they each branch.@@ -97,21 +96,21 @@  	* Since there are many different initial moves, the structure is a flat-topped /forest/ rather than a single apex /tree/. -}-newtype QualifiedMoveForest x y	= MkQualifiedMoveForest {-	deconstruct	:: [QualifiedMoveTree x y]+newtype QualifiedMoveForest	= MkQualifiedMoveForest {+	deconstruct	:: [QualifiedMoveTree] } deriving ( 	Eq, 	Show	-- CAVEAT: required by QuickCheck, but shouldn't actually be called.  ) -instance Property.Empty.Empty (QualifiedMoveForest x y) where+instance Property.Empty.Empty QualifiedMoveForest where 	empty	= MkQualifiedMoveForest Property.Empty.empty -instance Property.Null.Null (QualifiedMoveForest x y) where+instance Property.Null.Null QualifiedMoveForest where 	isNull MkQualifiedMoveForest { deconstruct = [] }	= True 	isNull _						= False -instance (Enum x, Enum y) => Notation.MoveNotation.ShowNotation (QualifiedMoveForest x y) where+instance Notation.MoveNotation.ShowNotation QualifiedMoveForest where 	showsNotation moveNotation MkQualifiedMoveForest { deconstruct = forest }	= showString $ Data.RoseTree.drawForest ( 		\(qualifiedMove, maybeOnymousResult)	-> Notation.MoveNotation.showsNotation moveNotation qualifiedMove $ Data.Maybe.maybe id ( 			\onymousResult -> showChar ' ' . shows onymousResult@@ -136,10 +135,9 @@  -- | Include the specified PGN-database into the /forest/, thus allowing more than one 'ContextualNotation.PGNDatabase.PGNDatabase' to be read. mergePGNDatabase-	:: (Eq x, Eq y)-	=> ContextualNotation.PGNDatabase.PGNDatabase x y-	-> QualifiedMoveForest x y-	-> QualifiedMoveForest x y+	:: ContextualNotation.PGNDatabase.PGNDatabase+	-> QualifiedMoveForest+	-> QualifiedMoveForest mergePGNDatabase pgnDatabase MkQualifiedMoveForest { deconstruct = initialForest }	= MkQualifiedMoveForest $ foldr ( 	\pgn -> merge ( 		mkCompositeIdentifier &&& Data.Maybe.maybe (@@ -149,15 +147,14 @@ 		map Component.Turn.getQualifiedMove . Model.Game.listTurnsChronologically $ ContextualNotation.PGN.getGame pgn	-- Extract the list of qualified moves defining this game. 	)  ) initialForest pgnDatabase where-	mkCompositeIdentifier :: ContextualNotation.PGN.PGN x y -> Name+	mkCompositeIdentifier :: ContextualNotation.PGN.PGN -> Name 	mkCompositeIdentifier	= unwords . map snd {-value-} . ContextualNotation.PGN.getIdentificationTagPairs  	merge-		:: (Eq x, Eq y)-		=> OnymousResult				-- ^ The name of this move-sequence, & the result.-		-> [Component.QualifiedMove.QualifiedMove x y]	-- ^ A chronological sequence of /qualified move/s.-		-> [QualifiedMoveTree x y]-		-> [QualifiedMoveTree x y]+		:: OnymousResult				-- ^ The name of this move-sequence, & the result.+		-> [Component.QualifiedMove.QualifiedMove]	-- ^ A chronological sequence of /qualified move/s.+		-> [QualifiedMoveTree]+		-> [QualifiedMoveTree] 	merge onymousResult qualifiedMoves@(qualifiedMove : remainingQualifiedMoves) forest	= case span ( 		\Data.Tree.Node { Data.Tree.rootLabel = (qualifiedMove', _) } -> Component.QualifiedMove.getMove qualifiedMove /= Component.QualifiedMove.getMove qualifiedMove' 	 ) forest of@@ -175,7 +172,7 @@ 		_ {-no match-}						-> mkLinkedList onymousResult qualifiedMoves : forest 	merge _ [] forest					= forest -	mkLinkedList :: OnymousResult -> [Component.QualifiedMove.QualifiedMove x y] -> QualifiedMoveTree x y+	mkLinkedList :: OnymousResult -> [Component.QualifiedMove.QualifiedMove] -> QualifiedMoveTree 	mkLinkedList onymousResult ~(qualifiedMove : remainingQualifiedMoves) 		| null remainingQualifiedMoves	= Data.Tree.Node { 			Data.Tree.rootLabel	= (qualifiedMove, Just onymousResult),@@ -187,28 +184,32 @@ 		}  -- | Constructor.-fromPGNDatabase :: (Eq x, Eq y) => ContextualNotation.PGNDatabase.PGNDatabase x y -> QualifiedMoveForest x y+fromPGNDatabase :: ContextualNotation.PGNDatabase.PGNDatabase -> QualifiedMoveForest fromPGNDatabase	= (`mergePGNDatabase` Property.Empty.empty {-QualifiedMoveForest-}) --- | Find the minimum number of /piece/s in any of the recorded /game/s.-findMinimumPieces :: QualifiedMoveForest x y -> Type.Count.NPieces+{- |+	* Find the minimum total number of /piece/s in any of the recorded /game/s, in order to determining whether a sample game is too small to converge on anything in the tree.++	* CAVEAT: no attempt is made to partition this total by logical colour, because there's no clear concept of the /minimum/ amongst the pairs discovered at each leaf-node.++	* N.B.: one call also measure other monotonically changing quantities (number of Pawns, number of Castleable Rooks, least advanced Pawn), but this is cheap.+-}+findMinimumPieces :: QualifiedMoveForest -> Type.Count.NPieces findMinimumPieces	= slave (-	State.Board.getNPieces (-		Data.Default.def	:: State.Board.Board Type.Length.X Type.Length.Y	-- CAVEAT: this assumes the game to which the moves in the forest refer.-	)+	2 * Component.Piece.nPiecesPerSide	-- CAVEAT: assuming a conventional starting position.  ) . deconstruct where 	slave nPieces []	= nPieces 	slave nPieces forest	= minimum $ map ( 		\Data.Tree.Node { 			Data.Tree.rootLabel	= (qualifiedMove, _), 			Data.Tree.subForest	= subForest-		} -> slave (-			Attribute.MoveType.nPiecesMutator (Component.QualifiedMove.getMoveType qualifiedMove) nPieces-		) subForest	-- Recurse.+		} -> let+			nPieces'	= Attribute.MoveType.nPiecesMutator (Component.QualifiedMove.getMoveType qualifiedMove) nPieces+		in nPieces' `seq` slave nPieces' subForest	-- Recurse. 	 ) forest  -- | Count the number of /game/s & distinct /positions/.-count :: QualifiedMoveForest x y -> (Type.Count.NGames, Type.Count.NPositions)+count :: QualifiedMoveForest -> (Type.Count.NGames, Type.Count.NPositions) count	= slave . deconstruct where 	slave	= Data.List.foldl' ( 		\(nGames, nPositions) Data.Tree.Node {@@ -230,15 +231,7 @@  	* N.B.: to construct a tree from the specified forest, the default initial /game/ is included at the apex. -}-toGameTree :: (-	Enum	x,-	Enum	y,-	Ord	x,-	Ord	y,-	Show	x,-	Show	y- ) => QualifiedMoveForest x y -> Model.GameTree.GameTree x y-{-# SPECIALISE toGameTree :: QualifiedMoveForest Type.Length.X Type.Length.Y -> Model.GameTree.GameTree Type.Length.X Type.Length.Y #-}+toGameTree :: QualifiedMoveForest -> Model.GameTree.GameTree toGameTree MkQualifiedMoveForest { deconstruct = qualifiedMoveForest }	= Model.GameTree.fromBareGameTree Data.Tree.Node { 	Data.Tree.rootLabel	= initialGame, 	Data.Tree.subForest	= map (slave initialGame) qualifiedMoveForest