bishbosh 0.1.2.0 → 0.1.3.0

raw patch · 135 files changed

+3890/−3256 lines, 135 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bishbosh.cabal +23/−16
• bishbosh.spec +1/−1
• changelog.markdown +25/−9
• makefile +13/−9
• src-exe/BishBosh/Play.hs +7/−28
• src-exe/BishBosh/State/PlayState.hs +23/−46
• src-exe/BishBosh/UI/CECP.hs +37/−71
• src-exe/BishBosh/UI/Raw.hs +44/−72
• src-exe/Duel/Data/Options.hs +5/−5
• src-exe/Duel/Process/Intermediary.hs +9/−12
• src-exe/Main.hs +14/−17
• src-lib/BishBosh/Attribute/ANSIColourCode.hs +0/−76
• src-lib/BishBosh/Attribute/ColourScheme.hs +0/−159
• src-lib/BishBosh/Attribute/Direction.hs +0/−265
• src-lib/BishBosh/Attribute/LogicalColour.hs +0/−144
• src-lib/BishBosh/Attribute/LogicalColourOfSquare.hs +0/−59
• src-lib/BishBosh/Attribute/MoveType.hs +9/−14
• src-lib/BishBosh/Attribute/PhysicalColour.hs +0/−119
• src-lib/BishBosh/Attribute/Rank.hs +0/−5
• src-lib/BishBosh/Cartesian/Coordinates.hs +148/−131
• src-lib/BishBosh/Cartesian/Ordinate.hs +11/−11
• src-lib/BishBosh/Cartesian/Vector.hs +60/−49
• src-lib/BishBosh/Colour/ANSIColourCode.hs +76/−0
• src-lib/BishBosh/Colour/ColourScheme.hs +159/−0
• src-lib/BishBosh/Colour/LogicalColour.hs +151/−0
• src-lib/BishBosh/Colour/LogicalColourOfSquare.hs +59/−0
• src-lib/BishBosh/Colour/PhysicalColour.hs +119/−0
• src-lib/BishBosh/Component/Accountant.hs +5/−5
• src-lib/BishBosh/Component/CastlingMove.hs +7/−7
• src-lib/BishBosh/Component/Move.hs +26/−14
• src-lib/BishBosh/Component/Piece.hs +67/−63
• src-lib/BishBosh/Component/PieceSquareByCoordinatesByRank.hs +53/−31
• src-lib/BishBosh/Component/QualifiedMove.hs +5/−0
• src-lib/BishBosh/Component/Turn.hs +5/−5
• src-lib/BishBosh/Component/Zobrist.hs +19/−19
• src-lib/BishBosh/ContextualNotation/PGN.hs +3/−3
• src-lib/BishBosh/ContextualNotation/PositionHashQualifiedMoveTree.hs +48/−57
• src-lib/BishBosh/ContextualNotation/QualifiedMoveForest.hs +6/−3
• src-lib/BishBosh/ContextualNotation/StandardAlgebraic.hs +20/−16
• src-lib/BishBosh/Data/RoseTree.hs +15/−2
• src-lib/BishBosh/Direction/Diagonal.hs +114/−0
• src-lib/BishBosh/Direction/Direction.hs +180/−0
• src-lib/BishBosh/Direction/Horizontal.hs +66/−0
• src-lib/BishBosh/Direction/Parallel.hs +104/−0
• src-lib/BishBosh/Direction/Vertical.hs +66/−0
• src-lib/BishBosh/Evaluation/Fitness.hs +42/−65
• src-lib/BishBosh/Evaluation/PositionHashQuantifiedGameTree.hs +27/−41
• src-lib/BishBosh/Evaluation/QuantifiedGame.hs +25/−22
• src-lib/BishBosh/Input/CommandLineOption.hs +1/−0
• src-lib/BishBosh/Input/EvaluationOptions.hs +25/−32
• src-lib/BishBosh/Input/NativeUIOptions.hs +4/−4
• src-lib/BishBosh/Input/Options.hs +20/−25
• src-lib/BishBosh/Input/PieceSquareTable.hs +44/−50
• src-lib/BishBosh/Input/RankValues.hs +2/−2
• src-lib/BishBosh/Input/SearchOptions.hs +9/−9
• src-lib/BishBosh/Input/UIOptions.hs +2/−2
• src-lib/BishBosh/Metric/CriterionValue.hs +6/−6
• src-lib/BishBosh/Metric/CriterionWeight.hs +6/−6
• src-lib/BishBosh/Metric/RankValue.hs +8/−8
• src-lib/BishBosh/Metric/WeightedMeanAndCriterionValues.hs +1/−1
• src-lib/BishBosh/Model/Game.hs +172/−169
• src-lib/BishBosh/Model/GameTree.hs +7/−5
• src-lib/BishBosh/Model/MoveFrequency.hs +14/−14
• src-lib/BishBosh/Model/PositionHashTree.hs +2/−1
• src-lib/BishBosh/Property/Arboreal.hs +0/−13
• src-lib/BishBosh/Property/Orientated.hs +24/−4
• src-lib/BishBosh/Property/Rotatable.hs +3/−1
• src-lib/BishBosh/Property/SelfValidating.hs +5/−0
• src-lib/BishBosh/Rule/GameTerminationReason.hs +6/−6
• src-lib/BishBosh/Rule/Result.hs +7/−7
• src-lib/BishBosh/Search/AlphaBeta.hs +28/−43
• src-lib/BishBosh/Search/KillerMoves.hs +11/−11
• src-lib/BishBosh/State/Board.hs +121/−134
• src-lib/BishBosh/State/CastleableRooksByLogicalColour.hs +34/−38
• src-lib/BishBosh/State/CoordinatesByRankByLogicalColour.hs +120/−80
• src-lib/BishBosh/State/EnPassantAbscissa.hs +21/−18
• src-lib/BishBosh/State/MaybePieceByCoordinates.hs +162/−146
• src-lib/BishBosh/State/Position.hs +8/−11
• src-lib/BishBosh/State/TurnsByLogicalColour.hs +28/−28
• src-lib/BishBosh/StateProperty/Censor.hs +22/−3
• src-lib/BishBosh/StateProperty/Hashable.hs +19/−5
• src-lib/BishBosh/StateProperty/Mutator.hs +20/−7
• src-lib/BishBosh/StateProperty/Seeker.hs +36/−10
• src-lib/BishBosh/StateProperty/View.hs +48/−0
• src-lib/BishBosh/Text/ShowColouredPrefix.hs +9/−9
• src-lib/BishBosh/Time/GameClock.hs +6/−6
• src-lib/BishBosh/Type/Crypto.hs +3/−3
• src-lib/BishBosh/Type/Mass.hs +53/−12
• src-test/BishBosh/Test/HUnit/Attribute/Direction.hs +0/−46
• src-test/BishBosh/Test/HUnit/Attribute/LogicalColour.hs +0/−41
• src-test/BishBosh/Test/HUnit/Cartesian/Coordinates.hs +6/−6
• src-test/BishBosh/Test/HUnit/Colour/LogicalColour.hs +41/−0
• src-test/BishBosh/Test/HUnit/Component/Move.hs +14/−14
• src-test/BishBosh/Test/HUnit/Component/Piece.hs +14/−14
• src-test/BishBosh/Test/HUnit/ContextualNotation/PositionHashQualifiedMoveTree.hs +8/−8
• src-test/BishBosh/Test/HUnit/ContextualNotation/StandardAlgebraic.hs +13/−13
• src-test/BishBosh/Test/HUnit/Direction/Direction.hs +46/−0
• src-test/BishBosh/Test/HUnit/Evaluation/Fitness.hs +14/−14
• src-test/BishBosh/Test/HUnit/Input/Options.hs +1/−4
• src-test/BishBosh/Test/HUnit/Model/Game.hs +18/−22
• src-test/BishBosh/Test/HUnit/Model/GameTree.hs +5/−5
• src-test/BishBosh/Test/HUnit/Search/Search.hs +2/−3
• src-test/BishBosh/Test/HUnit/State/Board.hs +93/−93
• src-test/BishBosh/Test/QuickCheck/Attribute/Direction.hs +0/−87
• src-test/BishBosh/Test/QuickCheck/Attribute/LogicalColour.hs +0/−56
• src-test/BishBosh/Test/QuickCheck/Cartesian/Coordinates.hs +21/−11
• src-test/BishBosh/Test/QuickCheck/Cartesian/Vector.hs +30/−15
• src-test/BishBosh/Test/QuickCheck/Colour/LogicalColour.hs +56/−0
• src-test/BishBosh/Test/QuickCheck/Component/Move.hs +11/−3
• src-test/BishBosh/Test/QuickCheck/Component/QualifiedMove.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Component/Turn.hs +6/−6
• src-test/BishBosh/Test/QuickCheck/ContextualNotation/PositionHashQualifiedMoveTree.hs +3/−1
• src-test/BishBosh/Test/QuickCheck/Direction/Direction.hs +116/−0
• src-test/BishBosh/Test/QuickCheck/Evaluation/PositionHashQuantifiedGameTree.hs +4/−3
• src-test/BishBosh/Test/QuickCheck/Input/EvaluationOptions.hs +20/−24
• src-test/BishBosh/Test/QuickCheck/Input/Options.hs +3/−15
• src-test/BishBosh/Test/QuickCheck/Input/PieceSquareTable.hs +3/−20
• src-test/BishBosh/Test/QuickCheck/Input/SearchOptions.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Model/Game.hs +53/−57
• src-test/BishBosh/Test/QuickCheck/Model/GameTree.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Notation/ICCFNumeric.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Notation/MoveNotation.hs +1/−2
• src-test/BishBosh/Test/QuickCheck/Notation/PureCoordinate.hs +1/−1
• src-test/BishBosh/Test/QuickCheck/Rule/Result.hs +2/−2
• src-test/BishBosh/Test/QuickCheck/Search/Search.hs +3/−2
• src-test/BishBosh/Test/QuickCheck/Search/SearchState.hs +2/−9
• src-test/BishBosh/Test/QuickCheck/State/Board.hs +40/−26
• src-test/BishBosh/Test/QuickCheck/State/CastleableRooksByLogicalColour.hs +9/−9
• src-test/BishBosh/Test/QuickCheck/StateProperty/Hashable.hs +5/−9
• src-test/BishBosh/Test/QuickCheck/StateProperty/Mutator.hs +90/−0
• src-test/BishBosh/Test/QuickCheck/StateProperty/View.hs +65/−0
• src-test/BishBosh/Test/QuickCheck/Type/Mass.hs +39/−0
• src-test/BishBosh/Test/QuickCheck/UI/Command.hs +2/−2
• src-test/HUnit.hs +5/−5
• src-test/QuickCheck.hs +8/−4

@@ -16,7 +16,7 @@ -- along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.  Name:		bishbosh-Version:	0.1.2.0+Version:	0.1.3.0 Copyright:	(C) 2018 Dr. Alistair Ward License:	GPL-3.0-or-later License-file:	LICENSE@@ -79,6 +79,7 @@     Default:		False  -- Whether, to wrap common types in 'newtype' for increased type-safety. CAVEAT: there's a ~10% performance-penalty.+-- CAVEAT: partly incompatible with 'narrownumbers'. flag newtypewrappers     Description:	Wrap common types in newtype for increased type-safety.     Manual:		True@@ -92,7 +93,8 @@     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'.+-- Whether to use precise (rational) types rather than floating-point.+-- CAVEAT: conceptually incompatible with 'narrownumbers'. flag precision     Description:	Use precise numerical types. CAVEAT: this is incompatible with either 'unboxedarrays' or 'narrownumbers'.     Manual:		True@@ -105,7 +107,7 @@     Default:		True  -- Whether to use unboxed arrays where possible.--- CAVEAT: incompatble with the flag 'precision'.+-- CAVEAT: incompatible with the flag 'precision', & to some extent 'newtypewrappers'. flag unboxedarrays     Description:	Use unboxed arrays.     Manual:		True@@ -170,19 +172,18 @@     Hs-source-dirs:	src-lib      Exposed-modules:-        BishBosh.Attribute.ANSIColourCode         BishBosh.Attribute.CaptureMoveSortAlgorithm-        BishBosh.Attribute.ColourScheme-        BishBosh.Attribute.Direction-        BishBosh.Attribute.LogicalColour-        BishBosh.Attribute.LogicalColourOfSquare         BishBosh.Attribute.MoveType-        BishBosh.Attribute.PhysicalColour         BishBosh.Attribute.Rank         BishBosh.Cartesian.Abscissa         BishBosh.Cartesian.Coordinates         BishBosh.Cartesian.Ordinate         BishBosh.Cartesian.Vector+        BishBosh.Colour.ANSIColourCode+        BishBosh.Colour.ColourScheme+        BishBosh.Colour.LogicalColour+        BishBosh.Colour.LogicalColourOfSquare+        BishBosh.Colour.PhysicalColour         BishBosh.Component.Accountant         BishBosh.Component.CastlingMove         BishBosh.Component.EitherQualifiedMove@@ -207,6 +208,11 @@         BishBosh.Data.Num         BishBosh.Data.Ratio         BishBosh.Data.RoseTree+        BishBosh.Direction.Diagonal+        BishBosh.Direction.Direction+        BishBosh.Direction.Horizontal+        BishBosh.Direction.Parallel+        BishBosh.Direction.Vertical         BishBosh.Evaluation.Fitness         BishBosh.Evaluation.PositionHashQuantifiedGameTree         BishBosh.Evaluation.QuantifiedGame@@ -275,6 +281,7 @@         BishBosh.StateProperty.Hashable         BishBosh.StateProperty.Mutator         BishBosh.StateProperty.Seeker+        BishBosh.StateProperty.View         BishBosh.State.TurnsByLogicalColour         BishBosh.Text.AutoComplete         BishBosh.Text.Case@@ -370,9 +377,6 @@     if flag(threaded)         GHC-options:	-threaded -    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@@ -403,11 +407,10 @@     Autogen-modules:	Paths_bishbosh      Other-modules:-        BishBosh.Test.HUnit.Attribute.Direction-        BishBosh.Test.HUnit.Attribute.LogicalColour         BishBosh.Test.HUnit.Attribute.Rank         BishBosh.Test.HUnit.Cartesian.Coordinates         BishBosh.Test.HUnit.Cartesian.Vector+        BishBosh.Test.HUnit.Colour.LogicalColour         BishBosh.Test.HUnit.Component.CastlingMove         BishBosh.Test.HUnit.Component.Move         BishBosh.Test.HUnit.Component.Piece@@ -415,6 +418,7 @@         BishBosh.Test.HUnit.ContextualNotation.PGN         BishBosh.Test.HUnit.ContextualNotation.PositionHashQualifiedMoveTree         BishBosh.Test.HUnit.ContextualNotation.StandardAlgebraic+        BishBosh.Test.HUnit.Direction.Direction         BishBosh.Test.HUnit.Evaluation.Fitness         BishBosh.Test.HUnit.Input.Options         BishBosh.Test.HUnit.Model.Game@@ -441,12 +445,11 @@      Other-modules:         BishBosh.Test.QuickCheck.Attribute.CaptureMoveSortAlgorithm-        BishBosh.Test.QuickCheck.Attribute.Direction-        BishBosh.Test.QuickCheck.Attribute.LogicalColour         BishBosh.Test.QuickCheck.Attribute.MoveType         BishBosh.Test.QuickCheck.Attribute.Rank         BishBosh.Test.QuickCheck.Cartesian.Coordinates         BishBosh.Test.QuickCheck.Cartesian.Vector+        BishBosh.Test.QuickCheck.Colour.LogicalColour         BishBosh.Test.QuickCheck.Component.Move         BishBosh.Test.QuickCheck.Component.Piece         BishBosh.Test.QuickCheck.Component.QualifiedMove@@ -459,6 +462,7 @@         BishBosh.Test.QuickCheck.ContextualNotation.StandardAlgebraic         BishBosh.Test.QuickCheck.Data.Foldable         BishBosh.Test.QuickCheck.Data.Integral+        BishBosh.Test.QuickCheck.Direction.Direction         BishBosh.Test.QuickCheck.Evaluation.PositionHashQuantifiedGameTree         BishBosh.Test.QuickCheck.Input.CECPFeatures         BishBosh.Test.QuickCheck.Input.CECPOptions@@ -496,12 +500,15 @@         BishBosh.Test.QuickCheck.State.Position         BishBosh.Test.QuickCheck.StateProperty.Censor         BishBosh.Test.QuickCheck.StateProperty.Hashable+        BishBosh.Test.QuickCheck.StateProperty.Mutator         BishBosh.Test.QuickCheck.StateProperty.Seeker+        BishBosh.Test.QuickCheck.StateProperty.View         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.Type.Mass         BishBosh.Test.QuickCheck.UI.Command         BishBosh.Test.QuickCheck.UI.PrintObject         BishBosh.Test.QuickCheck.UI.ReportObject

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

@@ -27,7 +27,7 @@  ## 0.0.0.8 * Corrected the parsing of FEN when an Enpassant-destination defined on file **b** was erroneously interpreted as a bishop in the previous **CastleableRooks** field.-* Added parent class **BishBosh.Property.ExtendedPositionDescription.EPD** for **Property.ForsythEdwards.FEN**, for which the latter typically has a default implementation of both methods.+* Added parent type-class **BishBosh.Property.ExtendedPositionDescription.EPD** for **Property.ForsythEdwards.FEN**, for which the latter typically has a default implementation of both methods.  ## 0.1.0.0 ### Bug-fixes:@@ -68,10 +68,10 @@ **Component.CastlingMove**	| Forked from module **Component.Move**. **Data.Enum**			| Currently single-function. **Data.Foldable**		| Currently single-function.-**Property.FixedMembership**	| Defines a class to which sum-types can conform.+**Property.FixedMembership**	| Defines a type-class to which sum-types can conform. **StateProperty.Censor**	| Relocated from directory **State/**.-**StateProperty.Mutator**	| defines a class to express the dual implementations within **State.Board**.-**StateProperty.Seeker**	| defines a class to express the dual implementations within **State.Board**.+**StateProperty.Mutator**	| defines a type-class to express the dual implementations within **State.Board**.+**StateProperty.Seeker**	| defines a type-class to express the dual implementations within **State.Board**. **Text.Case**			| Forked from **Text.ShowList** to contain case-related operations. **Text.Prefix**			| Forked from **Text.ShowList** to define the constant prefixes of log-messages. -----------------------------------------@@ -96,11 +96,11 @@ **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.Countable**		| Defines *newtype*s 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.Length**		| Replaced the polymorphic type-parameters **row** & **column** with *newtype*s 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.+**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**.@@ -110,7 +110,7 @@ * Refactored functions **BishBosh.ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMovesForPosition**, **BishBosh.Model.MoveFrequency.insertMoves** & **BishBosh.Model.GameTree.toMoveFrequency**. * Evaluation-criteria: 	+ Moved **BishBosh.Attribute.**{**CriterionValue**, **CriterionWeight**, **WeightedMeanAndCriterionValues**} to a new directory **Metric/**-	+ Implemented classes [**Num**, **Fractional**, **Real**] for data-types **BishBosh.Metric.**{**CriterionValue.CriterionValue**, **CriterionWeight.CriterionWeight**}, nullifying the requirement for exports.+	+ Implemented type-classes [**Num**, **Fractional**, **Real**] for data-types **BishBosh.Metric.**{**CriterionValue.CriterionValue**, **CriterionWeight.CriterionWeight**}, nullifying the requirement for exports. 	+ Replaced the pointless polymorphic payloads in data-types **BishBosh.Metric.**{**CriterionValue.CriterionValue**, **CriterionWeight.CriterionWeight**, **WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues**} with concrete types. * 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.@@ -134,7 +134,7 @@ 	+ 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:+		* Replaced the polymorphic type-parameters **x** & **y** with *newtype*s 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),@@ -145,4 +145,20 @@ 	+ 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**.++## 0.1.3.0+* Efficiency:+	+ Replaced the polymorphic type-parameter **pieceSquareValue** with a *newtype*, to then implement *unboxed* arrays without cluttering interfaces with type-constraint **Data.Array.Unboxed.IArray Data.Array.Unboxed.UArray pieceSquareValue**; performance-improvement was regrettably insignificant.+	+ Added some strictness to **BishBosh.Board.{exposesKing, movePiece, sumPieceSquareValueByLogicalColour}** & **BishBosh.Game.applyQualifiedMove**.+	+ Added function **BishBosh.Cartesian.Coordinates.applyAlongDirectionsFrom** to reduce sequential indexing by direction when extrapolating in all directions; deployed in new functions **BishBosh.State.MaybePieceByCoordinates.{findBlockingPieces, findAttackerInDirections}**+	+ Refactored function **BishBosh.Cartesian.Vector.toMaybeDirection** to eliminate call to **BishBosh.Property.Orientated.isStraight**.+	+ Refactored function **BishBosh.Component.Piece.canMoveBetween** to remove **let**-binding.+	+ Refactored function **BishBosh.State.EnPassantAbscissa.mkMaybeEnPassantAbscissa** to reduce calls to **BishBosh.State.MaybePieceByCoordinates.{findAttackerInDirection, findBlockingPiece}**.+* Structural:+	+ Added method **BishBosh.StateProperty.Mutator.movePiece** & implemented whole type-class in module **BishBosh.State.CoordinatesByRankByLogicalColour**.+	+ Implemented type-class **BishBosh.Property.SelfValidating.SelfValidating** in modules **BishBosh.State.{MaybePieceByCoordinates, CoordinatesByRankByLogicalColour, Board}**.+	+ Created a new type-class **BishBosh.StateProperty.View.View** (implemented in **BishBosh.State.{MaybePieceByCoordinates, CoordinatesByRankByLogicalColour}**), to abstract construction of a view & translation between views.+	+ Rewrote module **BishBosh.Attribute.Direction** to remove the 9th invalid state from the data-structure, & to express the division between *parallel* & *diagonal* instances; which degraded performance slightly. Added new methods to class **BishBosh.Property.Orientated.Orientated**.+	+ Relocated colour-related modules from **BishBosh/Attribute/** to **BishBosh/Colour/**.+	+ Re-ordered the parameters of functions which access record-structures, to make the record the first parameter; cf. those that mutate the record-structure, which receive it last. 

@@ -53,33 +53,37 @@ test: 	@for FLAG in -polyparse newtypewrappers narrownumbers unboxedarrays -hxtrelaxng -threaded precision; do\ 		echo $${FLAG};\-		stack '$@' --flag="$(PACKAGE_NAME):$${FLAG}" $(GHC_OPTIONS) || break;\+		stack '$@' --flag="$(PACKAGE_NAME):$${FLAG}" $(GHC_OPTIONS) '$(PACKAGE_NAME):test:hunit-tests' '$(PACKAGE_NAME):test:quickcheck-tests' || break;\ 	done  # Compile with random CPP-flags & run the test-suites. randomTest: 	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)+	stack test $${FLAGS} $(GHC_OPTIONS) '$(PACKAGE_NAME):test:hunit-tests' '$(PACKAGE_NAME):test:quickcheck-tests'  # Profile a single-threaded build, to access entry-counts. prof:-	@stack install --profile --flag='bishbosh:-threaded' $(GHC_OPTIONS);-	sleep 16;	# Let the test-machine reach a quiescent state.+	@stack install --profile --flag='$(PACKAGE_NAME):-threaded' $(GHC_OPTIONS) '$(PACKAGE_NAME):exe:$(PACKAGE_NAME)';+	sleep 32;	# 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);+	@stack install --profile $(GHC_OPTIONS) '$(PACKAGE_NAME):exe:$(PACKAGE_NAME)'; 	@$(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)+# Install 'bishbosh'.+$(BIN_DIR)/$(PACKAGE_NAME):+	@stack install $(GHC_OPTIONS) '$(PACKAGE_NAME):exe:$(PACKAGE_NAME)'  # Run the installed application as an xboard-engine. xboard: $(BIN_DIR)/$(PACKAGE_NAME)-	@$@ -fcp '$(PACKAGE_NAME) -i "config/CECP/$(PACKAGE_NAME)_black.xml" +RTS -N2 -RTS'+	@$@ -fcp '$(PACKAGE_NAME) -i 'config/CECP/$(PACKAGE_NAME)_black.xml' +RTS -N2 -RTS'++# Install 'duel'.+$(BIN_DIR)/duel: $(BIN_DIR)/$(PACKAGE_NAME)+	@stack install $(GHC_OPTIONS) '$(PACKAGE_NAME):exe:duel'  # Start a battle. duel: $(BIN_DIR)/duel

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, FlexibleContexts #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -58,10 +57,8 @@ 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.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	Control.Monad import qualified	Data.Bits@@ -72,37 +69,19 @@ import qualified	System.Random import			System.FilePath((</>)) -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- -- | Plays the game according to the specified configuration. play :: (-	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).-#endif-	Data.Bits.FiniteBits		positionHash,-	Fractional			pieceSquareValue,-	Ord				positionHash,-	Real				pieceSquareValue,-	Show				pieceSquareValue,-	System.Random.Random		positionHash,-	System.Random.RandomGen		randomGen+	Data.Bits.FiniteBits	positionHash,+	Ord			positionHash,+	System.Random.Random	positionHash,+	System.Random.RandomGen	randomGen  ) 	=> Input.Verbosity.Verbosity 	-> randomGen-	-> Input.Options.Options pieceSquareValue+	-> Input.Options.Options 	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest	-- ^ Standard openings.-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash)-{-# SPECIALISE play-	:: System.Random.RandomGen randomGen-	=> Input.Verbosity.Verbosity-	-> randomGen-	-> Input.Options.Options Type.Mass.PieceSquareValue-	-> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)- #-}+	-> IO (State.PlayState.PlayState positionHash)+{-# SPECIALISE play :: Input.Verbosity.Verbosity -> System.Random.StdGen -> Input.Options.Options -> ContextualNotation.QualifiedMoveForest.QualifiedMoveForest -> IO (State.PlayState.PlayState Type.Crypto.PositionHash) #-} play verbosity randomGen options qualifiedMoveForest	= Data.Maybe.maybe ( 	return {-to IO-monad-} Data.Default.def {-game-}  ) (

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, FlexibleContexts #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -82,40 +81,30 @@ import qualified	Data.Ord import qualified	Factory.Math.Statistics -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- -- | The type threaded through the sequence of /game/s during play.-data PlayState pieceSquareValue positionHash	= MkPlayState {+data PlayState positionHash	= MkPlayState { 	getCriterionValues			:: [[Metric.CriterionValue.CriterionValue]],					-- ^ The /criterion-value/s accumulated during the game. 	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.+	getOptions				:: Input.Options.Options,							-- ^ The constant options by which the game is configured. 	getMaybeApplicationTerminationReason	:: Maybe State.ApplicationTerminationReason.ApplicationTerminationReason	-- ^ Whether the game has terminated. }  -- | Constructor.-initialise :: (-#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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Real				pieceSquareValue- )-	=> Input.Options.Options pieceSquareValue+initialise+	:: Data.Bits.Bits positionHash+	=> Input.Options.Options 	-> Component.Zobrist.Zobrist positionHash 	-> Model.GameTree.MoveFrequency 	-> Model.Game.Game-	-> PlayState pieceSquareValue positionHash+	-> PlayState positionHash {-# SPECIALISE initialise-	:: Input.Options.Options Type.Mass.PieceSquareValue+	:: Input.Options.Options 	-> Component.Zobrist.Zobrist Type.Crypto.PositionHash 	-> Model.GameTree.MoveFrequency 	-> Model.Game.Game-	-> PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash+	-> PlayState Type.Crypto.PositionHash  #-} initialise options zobrist moveFrequency game	= MkPlayState { 	getCriterionValues			= [],@@ -129,27 +118,21 @@ }  -- | Accessor.-getGame :: PlayState pieceSquareValue positionHash -> Model.Game.Game+getGame :: PlayState 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	= PlayState pieceSquareValue positionHash -> PlayState pieceSquareValue positionHash+type Transformation positionHash	= PlayState positionHash -> PlayState positionHash  -- | Mutator.-setPositionHashQuantifiedGameTree :: Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree positionHash -> Transformation pieceSquareValue positionHash+setPositionHashQuantifiedGameTree :: Evaluation.PositionHashQuantifiedGameTree.PositionHashQuantifiedGameTree positionHash -> Transformation 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 :: (-#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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Real				pieceSquareValue- ) => Model.Game.Game -> Transformation pieceSquareValue positionHash+reconstructPositionHashQuantifiedGameTree :: Data.Bits.Bits positionHash => Model.Game.Game -> Transformation positionHash+{-# SPECIALISE reconstructPositionHashQuantifiedGameTree :: Model.Game.Game -> Transformation Type.Crypto.PositionHash #-} reconstructPositionHashQuantifiedGameTree game playState@MkPlayState { 	getZobrist		= zobrist, 	getMoveFrequency	= moveFrequency,@@ -161,14 +144,8 @@  ) playState  -- | Reset to the initial state.-resetPositionHashQuantifiedGameTree :: (-#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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Real				pieceSquareValue- ) => Transformation pieceSquareValue positionHash+resetPositionHashQuantifiedGameTree :: Data.Bits.Bits positionHash => Transformation positionHash+{-# SPECIALISE resetPositionHashQuantifiedGameTree :: Transformation Type.Crypto.PositionHash #-} resetPositionHashQuantifiedGameTree playState	= reconstructPositionHashQuantifiedGameTree Data.Default.def playState { 	getCriterionValues			= [], 	getMaybeApplicationTerminationReason	= Nothing@@ -178,14 +155,14 @@ updateWithAutomaticMove 	:: [Metric.CriterionValue.CriterionValue] 	-> Search.SearchState.SearchState positionHash-	-> Transformation pieceSquareValue positionHash+	-> Transformation positionHash updateWithAutomaticMove criterionValues searchState playState	= playState { 	getCriterionValues	= criterionValues : getCriterionValues playState, 	getSearchState		= searchState }  -- | Mutator.-updateWithManualMove :: Model.Game.Game -> Transformation pieceSquareValue positionHash+updateWithManualMove :: Model.Game.Game -> Transformation 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."@@ -205,7 +182,7 @@ 	Floating	standardDeviation, 	Fractional	mean  )-	=> PlayState pieceSquareValue positionHash+	=> PlayState positionHash 	-> [(mean, standardDeviation)] calculateCriterionValueStatistics MkPlayState { getCriterionValues = criterionValues }	= map ( 	(@@ -216,7 +193,7 @@  ) $ Data.List.transpose criterionValues  -- | Resignation by the player who currently holds the choice of move.-resign :: Transformation pieceSquareValue positionHash+resign :: Transformation positionHash resign playState@MkPlayState { getSearchState = searchState }	= setPositionHashQuantifiedGameTree ( 	Evaluation.PositionHashQuantifiedGameTree.resign $ Search.SearchState.getPositionHashQuantifiedGameTree searchState  ) playState@@ -224,7 +201,7 @@ -- | 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 	:: String	-- ^ Move-string.-	-> PlayState pieceSquareValue positionHash+	-> PlayState positionHash 	-> [String]	-- ^ Suggested corrections. suggestCorrections moveString playState@MkPlayState { getOptions = options } 	| Model.Game.isTerminated game	= []@@ -236,12 +213,12 @@  -- | Whether the game in the first /play-state/ has more plies than that in the second. hasMorePlies-	:: PlayState pieceSquareValue positionHash-	-> PlayState pieceSquareValue positionHash+	:: PlayState positionHash+	-> PlayState 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 -> Bool+hasApplicationTerminationBeenRequested :: PlayState positionHash -> Bool hasApplicationTerminationBeenRequested MkPlayState { getMaybeApplicationTerminationReason = maybeApplicationTerminationReason }	= Data.Maybe.isJust maybeApplicationTerminationReason 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -106,10 +106,6 @@ import qualified	System.Random import qualified	ToolShed.System.Random -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- -- | Used in output to prefix hints. hintTag :: String hintTag		= "Hint:"@@ -169,7 +165,7 @@ showsThinking 	:: Property.ShowFloat.ShowFloat stoppedWatch 	=> Type.Count.NPlies		-- ^ Search-depth.-	-> Input.EvaluationOptions.EvaluationOptions pieceSquareValue+	-> Input.EvaluationOptions.EvaluationOptions 	-> Type.Mass.WeightedMean 	-> stoppedWatch 	-> Type.Count.NPositions	-- ^ Nodes searched.@@ -179,7 +175,7 @@ 	shows searchDepth, 	shows . (round :: Type.Mass.RankValue -> Int) $ 100 {-centi-Pawns-} * ( 		uncurry (/) . (-			Input.RankValues.calculateMaximumTotalValue &&& realToFrac . Input.RankValues.findRankValue Attribute.Rank.Pawn+			Input.RankValues.calculateMaximumTotalValue &&& realToFrac . (`Input.RankValues.findRankValue` Attribute.Rank.Pawn) 		) $ Input.EvaluationOptions.getRankValues evaluationOptions 	) * realToFrac weightedMean, 	Property.ShowFloat.showsFloat (shows . (round :: Double -> Int) . (* 100)) stoppedWatch,@@ -191,31 +187,17 @@  	* 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. (-	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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Ord				positionHash,-	Real				pieceSquareValue,-	Show				pieceSquareValue,-	System.Random.RandomGen		randomGen+readMove :: forall positionHash randomGen. (+	Data.Bits.Bits		positionHash,+	Ord			positionHash,+	System.Random.RandomGen	randomGen  ) 	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen 	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState pieceSquareValue positionHash-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash)-{-# SPECIALISE readMove-	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash-	-> randomGen-	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)- #-}+	-> State.PlayState.PlayState positionHash+	-> IO (State.PlayState.PlayState positionHash)+{-# SPECIALISE readMove :: ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash -> System.Random.StdGen -> Time.StopWatch.StopWatch -> State.PlayState.PlayState Type.Crypto.PositionHash -> IO (State.PlayState.PlayState Type.Crypto.PositionHash) #-} readMove positionHashQualifiedMoveTree randomGen	= slave where 	slave runningWatch playState	= let 		(game, options)			= State.PlayState.getGame &&& State.PlayState.getOptions $ playState@@ -235,7 +217,7 @@ 		\cecpOptions -> let 			displaySAN	= Input.CECPOptions.getDisplaySAN cecpOptions -			onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState pieceSquareValue positionHash)+			onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState positionHash) 			onCommand UI.Command.Hint	= do 				Control.Monad.unless (Model.Game.isTerminated game) . Data.Maybe.maybe ( 					do@@ -253,7 +235,7 @@ 								) ( 									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)+								else Notation.MoveNotation.showNotation moveNotation $ Evaluation.QuantifiedGame.getLastTurn 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@@ -261,7 +243,7 @@ 						else Notation.MoveNotation.showNotation moveNotation qualifiedMove 				 ) $ ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen ( 					Input.StandardOpeningOptions.getPreferVictories . Input.SearchOptions.getStandardOpeningOptions $ searchOptions-				 ) tryToMatchSwitches game positionHashQualifiedMoveTree+				 ) tryToMatchSwitches positionHashQualifiedMoveTree game  				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@@ -274,22 +256,19 @@ 				Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowPrefix.showsPrefixInfo "quitting on request."  				return {-to IO-monad-} playState { State.PlayState.getMaybeApplicationTerminationReason = Just State.ApplicationTerminationReason.byRequest }-			onCommand (UI.Command.Report reportObject)	= do+			onCommand (UI.Command.Report reportObject)	= let+				showMoves :: Notation.MoveNotation.ShowNotation a => [a] -> ShowS+				showMoves	= Text.ShowList.showsFormattedList' (Notation.MoveNotation.showsNotation moveNotation)+			 in do 				putStrLn . tellUser =<< ( 					case reportObject of-						UI.ReportObject.AvailableMoves	-> return {-to IO-monad-} . ($ ".") . Text.ShowList.showsFormattedList (-							showChar '|'-						 ) (-							Notation.MoveNotation.showsNotation moveNotation-						 ) . Model.Game.findQualifiedMovesAvailableToNextPlayer+						UI.ReportObject.AvailableMoves		-> return {-to IO-monad-} . ($ ".") . showMoves . Model.Game.findQualifiedMovesAvailableToNextPlayer 						UI.ReportObject.Board			-> return {-to IO-monad-} . show . Model.Game.getBoard 						UI.ReportObject.EPD			-> return {-to IO-monad-} . Property.ExtendedPositionDescription.showEPD 						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-} . ($ "") . Text.ShowList.showsFormattedList' (-							Notation.MoveNotation.showsNotation moveNotation-						 ) . Model.Game.listTurnsChronologically+						UI.ReportObject.Moves			-> return {-to IO-monad-} . ($ ".") . showMoves . Model.Game.listTurnsChronologically 						UI.ReportObject.PGN			-> fmap ($ ".") . ContextualNotation.PGN.showsGame 						UI.ReportObject.ReversiblePlyCount	-> return {-to IO-monad-} . show . State.InstancesByPosition.countConsecutiveRepeatablePlies . Model.Game.getInstancesByPosition 				 ) game@@ -320,7 +299,7 @@ 					} 				} 			onCommand (UI.Command.RollBack maybeNPlies)	= let-				rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState pieceSquareValue positionHash)+				rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState 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@@ -386,7 +365,7 @@  					return {-to IO-monad-} playState { State.PlayState.getOptions = Input.Options.swapSearchDepth options } -			eventLoop :: IO (State.PlayState.PlayState pieceSquareValue positionHash)+			eventLoop :: IO (State.PlayState.PlayState positionHash) 			eventLoop	= getLine >>= \line -> do 				Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "received \"" $ showString line "\"." @@ -434,7 +413,7 @@ 										[(name, _result)]	-> showString ":\t" . showString name 										_			-> id 								) ""-							 ) $ ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves tryToMatchSwitches game positionHashQualifiedMoveTree+							 ) $ ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMoves tryToMatchSwitches positionHashQualifiedMoveTree game  							eventLoop 						"computer"	-> eventLoop	-- No action required.@@ -973,10 +952,10 @@  					maybePaused	= Input.CECPOptions.getMaybePaused cecpOptions -					moveCommand :: String -> IO (State.PlayState.PlayState pieceSquareValue positionHash)+					moveCommand :: String -> IO (State.PlayState.PlayState positionHash) 					moveCommand moveString	= case Notation.MoveNotation.readsQualifiedMove moveNotation moveString of 						[(eitherQualifiedMove, "")]-							| Just errorMessage <- Model.Game.validateEitherQualifiedMove eitherQualifiedMove game	-> do+							| Just errorMessage <- Model.Game.validateEitherQualifiedMove game eitherQualifiedMove	-> do 								Control.Monad.unless (verbosity == minBound) . System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixError . shows moveString . showString " is illegal; " $ shows errorMessage "."  								putStrLn $ mkIllegalMoveMessage errorMessage moveString@@ -996,7 +975,7 @@ 										) $ Model.Game.maybeLastTurn game' 									 ) . showString " was requested after " $ Property.ShowFloat.showsFloatToN nDecimalDigits stoppedWatch "s." -									case ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMovesForPosition game' positionHashQualifiedMoveTree of+									case ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMovesForPosition positionHashQualifiedMoveTree game' of 										[]			-> return () 										onymousQualifiedMoves	-> System.IO.hPutStrLn System.IO.stderr . Text.ShowPrefix.showsPrefixInfo . showString "matches archived game(s):" $ ContextualNotation.QualifiedMoveForest.showsNames ( 											Input.IOOptions.getMaybeMaximumPGNNames ioOptions@@ -1023,29 +1002,16 @@ 	 ) $ Input.UIOptions.getEitherNativeUIOrCECPOptions uiOptions  -- | Plays the game.-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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Ord				positionHash,-	Real				pieceSquareValue,-	Show				pieceSquareValue,-	System.Random.RandomGen		randomGen+takeTurns :: forall positionHash randomGen. (+	Data.Bits.Bits		positionHash,+	Ord			positionHash,+	System.Random.RandomGen	randomGen  ) 	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen-	-> State.PlayState.PlayState pieceSquareValue positionHash-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash)-{-# SPECIALISE takeTurns-	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash-	-> randomGen-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)- #-}+	-> State.PlayState.PlayState positionHash+	-> IO (State.PlayState.PlayState positionHash)+{-# SPECIALISE takeTurns :: ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash -> System.Random.StdGen -> State.PlayState.PlayState Type.Crypto.PositionHash -> IO (State.PlayState.PlayState Type.Crypto.PositionHash) #-} takeTurns positionHashQualifiedMoveTree randomGen playState	= do 	mVar	<- Control.Concurrent.newEmptyMVar @@ -1066,8 +1032,8 @@ 			:: Maybe (Concurrent.Pondering.Pondering Component.Move.Move) 			-> Maybe Type.Count.NPlies 			-> [randomGen]-			-> State.PlayState.PlayState pieceSquareValue positionHash-			-> IO (State.PlayState.PlayState pieceSquareValue positionHash)+			-> State.PlayState.PlayState positionHash+			-> IO (State.PlayState.PlayState 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 (@@ -1083,7 +1049,7 @@ 					do 						playState''	<- readMove positionHashQualifiedMoveTree randomGen' runningWatch playState'	-- Read the user's command or move. -						(,) playState'' `fmap` (+						(,) playState'' <$> ( 							if playState' `State.PlayState.hasMorePlies` playState'' 								then {-rolled-back-} Data.Maybe.maybe ( 									return {-to IO-monad-} Nothing@@ -1165,7 +1131,7 @@ 											State.PlayState.updateWithAutomaticMove ( 												Metric.WeightedMeanAndCriterionValues.getCriterionValues $ Evaluation.QuantifiedGame.getWeightedMeanAndCriterionValues quantifiedGame 											) searchState' playState'-										 ) `fmap` if ponderMode && Input.SearchOptions.getUsePondering searchOptions+										 ) <$> if ponderMode && Input.SearchOptions.getUsePondering searchOptions 											then case continuation of 												quantifiedGame' {-1st move after ours in optimal move-sequence-} : _	-> fmap Just . ( 													\positionHashQuantifiedGameTree'' -> Concurrent.Pondering.ponder (@@ -1213,7 +1179,7 @@ 						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.+					 ) positionHashQualifiedMoveTree game'	-- 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

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -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.Mass						as Type.Mass import qualified	BishBosh.UI.Command						as UI.Command import qualified	BishBosh.UI.PrintObject						as UI.PrintObject import qualified	BishBosh.UI.ReportObject					as UI.ReportObject@@ -88,40 +87,22 @@ import qualified	System.Random import qualified	ToolShed.System.Random -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- {- | 	* Reads a command-sequence from the user, terminating in either a request to move or to exit the game.  	* 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. (-	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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Ord				positionHash,-	Real				pieceSquareValue,-	Show				pieceSquareValue,-	System.Random.RandomGen		randomGen+readMove :: forall positionHash randomGen. (+	Data.Bits.Bits		positionHash,+	Ord			positionHash,+	System.Random.RandomGen	randomGen  ) 	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen 	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState pieceSquareValue positionHash-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash)-{-# SPECIALISE readMove-	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash-	-> randomGen-	-> Time.StopWatch.StopWatch-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)- #-}+	-> State.PlayState.PlayState positionHash+	-> IO (State.PlayState.PlayState positionHash)+{-# SPECIALISE readMove :: ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash -> System.Random.StdGen -> Time.StopWatch.StopWatch -> State.PlayState.PlayState Type.Crypto.PositionHash -> IO (State.PlayState.PlayState 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@@ -137,7 +118,9 @@  in ( 	\nativeUIOptions -> let 		show2D :: Model.Game.Game -> String-		show2D	= State.MaybePieceByCoordinates.show2D (+		show2D g	= State.MaybePieceByCoordinates.show2D (+			State.Board.getMaybePieceByCoordinates $ Model.Game.getBoard g+		 ) ( 			snd {-columns-} $ Input.NativeUIOptions.getBoardMagnification nativeUIOptions 		 ) ( 			Input.NativeUIOptions.getColourScheme nativeUIOptions@@ -145,9 +128,9 @@ 			Input.NativeUIOptions.getDepictFigurine nativeUIOptions 		 ) ( 			Notation.MoveNotation.getOrigin moveNotation-		 ) . State.Board.getMaybePieceByCoordinates . Model.Game.getBoard+		 ) -		onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState pieceSquareValue positionHash)+		onCommand :: UI.Command.Command -> IO (State.PlayState.PlayState positionHash) 		onCommand UI.Command.Hint	= do 			Control.Monad.unless (Model.Game.isTerminated game) . Data.Maybe.maybe ( 				do@@ -173,7 +156,7 @@ 				ContextualNotation.PositionHashQualifiedMoveTree.maybeRandomlySelectOnymousQualifiedMove randomGen 			 ) ( 				Input.StandardOpeningOptions.getPreferVictories &&& Input.StandardOpeningOptions.getMatchSwitches $ Input.SearchOptions.getStandardOpeningOptions searchOptions-			 ) game positionHashQualifiedMoveTree+			 ) positionHashQualifiedMoveTree game  			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@@ -186,21 +169,18 @@ 			Control.Monad.when (verbosity == maxBound) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "quitting on request."  			return {-to IO-monad-} playState { State.PlayState.getMaybeApplicationTerminationReason = Just State.ApplicationTerminationReason.byRequest }-		onCommand (UI.Command.Report reportObject)	= do+		onCommand (UI.Command.Report reportObject)	= let+			showMoves :: Notation.MoveNotation.ShowNotation a => [a] -> ShowS+			showMoves	= Text.ShowList.showsFormattedList' (Notation.MoveNotation.showsNotation moveNotation)+		 in do 			($ game) $ case reportObject of-				UI.ReportObject.AvailableMoves	-> putStrLn . ($ ".") . Text.ShowList.showsFormattedList (-					showChar '|'-				 ) (-					Notation.MoveNotation.showsNotation moveNotation-				 ) . Model.Game.findQualifiedMovesAvailableToNextPlayer+				UI.ReportObject.AvailableMoves		-> putStrLn . ($ ".") . showMoves . Model.Game.findQualifiedMovesAvailableToNextPlayer 				UI.ReportObject.Board			-> putStrLn . show2D 				UI.ReportObject.EPD			-> putStrLn . Property.ExtendedPositionDescription.showEPD 				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 . ($ "") . Text.ShowList.showsFormattedList' (-					Notation.MoveNotation.showsNotation moveNotation-				 ) . Model.Game.listTurnsChronologically+				UI.ReportObject.Moves			-> putStrLn . ($ ".") . showMoves . Model.Game.listTurnsChronologically 				UI.ReportObject.PGN			-> putStrLn . ($ ".") <=< ContextualNotation.PGN.showsGame 				UI.ReportObject.ReversiblePlyCount	-> print . State.InstancesByPosition.countConsecutiveRepeatablePlies . Model.Game.getInstancesByPosition @@ -216,7 +196,7 @@  			return {-to IO-monad-} $ State.PlayState.resetPositionHashQuantifiedGameTree playState 		onCommand (UI.Command.RollBack maybeNPlies)	= let-			rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState pieceSquareValue positionHash)+			rollBack :: Type.Count.NPlies -> IO (State.PlayState.PlayState positionHash) 			rollBack nPlies 				| (game', _) : _ <- drop (fromIntegral $ pred nPlies) $ Model.Game.rollBack game	= do 					Control.Monad.when (verbosity == maxBound) . putStrLn $ show2D game'@@ -288,7 +268,7 @@  				return {-to IO-monad-} playState { State.PlayState.getOptions = Input.Options.swapSearchDepth options } -		eventLoop :: IO (State.PlayState.PlayState pieceSquareValue positionHash)+		eventLoop :: IO (State.PlayState.PlayState positionHash) 		eventLoop	= getLine >>= \line -> case Data.List.Extra.trim line of 			"?"	-> onCommand $ UI.Command.Print UI.PrintObject.Help 			':' : s	-> (@@ -310,7 +290,7 @@ 				corrections	= State.PlayState.suggestCorrections s playState 			 in case Notation.MoveNotation.readsQualifiedMove moveNotation s of 				[(eitherQualifiedMove, "")]-					| Just errorMessage <- Model.Game.validateEitherQualifiedMove eitherQualifiedMove game	-> do+					| Just errorMessage <- Model.Game.validateEitherQualifiedMove game eitherQualifiedMove	-> do 						System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixError . shows s . showString " is illegal; " $ shows errorMessage "."  						Control.Monad.unless (null corrections) . System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "did you mean " $ shows corrections " ?"@@ -330,7 +310,7 @@ 								) $ Model.Game.maybeLastTurn game' 							 ) . showString " was requested after " $ Property.ShowFloat.showsFloatToN nDecimalDigits stoppedWatch "s." -							case ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMovesForPosition game' positionHashQualifiedMoveTree of+							case ContextualNotation.PositionHashQualifiedMoveTree.findNextOnymousQualifiedMovesForPosition positionHashQualifiedMoveTree game' of 								[]			-> return {-to IO-monad-} () 								onymousQualifiedMoves	-> System.IO.hPutStrLn System.IO.stderr . Text.ShowColouredPrefix.showsPrefixInfo . showString "matches archived game(s):" $ ContextualNotation.QualifiedMoveForest.showsNames maybeMaximumPGNNames ( 									concatMap (@@ -359,29 +339,16 @@  ) $ Input.UIOptions.getEitherNativeUIOrCECPOptions uiOptions  -- | Plays the game.-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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Ord				positionHash,-	Real				pieceSquareValue,-	Show				pieceSquareValue,-	System.Random.RandomGen		randomGen+takeTurns :: forall positionHash randomGen. (+	Data.Bits.Bits		positionHash,+	Ord			positionHash,+	System.Random.RandomGen	randomGen  ) 	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree positionHash 	-> randomGen-	-> State.PlayState.PlayState pieceSquareValue positionHash-	-> IO (State.PlayState.PlayState pieceSquareValue positionHash)-{-# SPECIALISE takeTurns-	:: System.Random.RandomGen randomGen-	=> ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash-	-> randomGen-	-> State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash-	-> IO (State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)- #-}+	-> State.PlayState.PlayState positionHash+	-> IO (State.PlayState.PlayState positionHash)+{-# SPECIALISE takeTurns :: ContextualNotation.PositionHashQualifiedMoveTree.PositionHashQualifiedMoveTree Type.Crypto.PositionHash -> System.Random.StdGen -> State.PlayState.PlayState Type.Crypto.PositionHash -> IO (State.PlayState.PlayState Type.Crypto.PositionHash) #-} takeTurns positionHashQualifiedMoveTree randomGen playState	= let 	options	= State.PlayState.getOptions playState @@ -398,7 +365,9 @@  		let 			show2D :: Model.Game.Game -> String-			show2D	= State.MaybePieceByCoordinates.show2D (+			show2D game	= State.MaybePieceByCoordinates.show2D (+				State.Board.getMaybePieceByCoordinates $ Model.Game.getBoard game+			 ) ( 				snd {-columns-} $ Input.NativeUIOptions.getBoardMagnification nativeUIOptions 			 ) ( 				Input.NativeUIOptions.getColourScheme nativeUIOptions@@ -406,14 +375,14 @@ 				Input.NativeUIOptions.getDepictFigurine nativeUIOptions 			 ) ( 				Notation.MoveNotation.getOrigin moveNotation-			 ) . State.Board.getMaybePieceByCoordinates . Model.Game.getBoard+			 )  			slave 				:: Maybe (Concurrent.Pondering.Pondering Component.Move.Move) 				-> Maybe Type.Count.NPlies 				-> [randomGen]-				-> State.PlayState.PlayState pieceSquareValue positionHash-				-> IO (State.PlayState.PlayState pieceSquareValue positionHash)+				-> State.PlayState.PlayState positionHash+				-> IO (State.PlayState.PlayState 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 (@@ -424,7 +393,7 @@ 						do 							playState''	<- readMove positionHashQualifiedMoveTree randomGen' runningWatch playState'	-- Block reading a command-sequence terminating in a move from a manual player. -							(,) playState'' `fmap` (+							(,) playState'' <$> ( 								if playState' `State.PlayState.hasMorePlies` playState'' 									then {-rolled-back-} Data.Maybe.maybe ( 										return {-to IO-monad-} Nothing@@ -444,7 +413,10 @@ 								 ) . System.IO.hPutStrLn System.IO.stderr $ Text.ShowColouredPrefix.showsPrefixInfo "failed to find any suitable archived move."  								let-									search ss	= Control.Monad.Reader.runReader (Search.Search.search searchDepth' ss) searchOptions'+									search ss	= Control.Monad.Reader.runReader (+										Search.Search.search searchDepth' ss+									 ) searchOptions'+ 									searchResult	= search $ State.PlayState.getSearchState playState'  								Data.Maybe.maybe (@@ -492,7 +464,7 @@ 												State.PlayState.updateWithAutomaticMove ( 													Metric.WeightedMeanAndCriterionValues.getCriterionValues $ Evaluation.QuantifiedGame.getWeightedMeanAndCriterionValues quantifiedGame 												) searchState' playState'-											 ) `fmap` if Input.SearchOptions.getUsePondering searchOptions+											 ) <$> if Input.SearchOptions.getUsePondering searchOptions 												then case continuation of 													quantifiedGame' {-1st move after ours in optimal move-sequence-} : _	-> fmap Just . ( 														\positionHashQuantifiedGameTree'' -> Concurrent.Pondering.ponder (@@ -538,7 +510,7 @@ 							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.+						 ) positionHashQualifiedMoveTree game'	-- 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' `Map.lookup` Input.SearchOptions.getSearchDepthByLogicalColour searchOptions'	-- Determinate whether the next player is manual. 					 ) >>= (

@@ -46,13 +46,13 @@ 	appendInputConfigFilePath ) where -import qualified	Control.Exception-import qualified	Data.Default-import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour+import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour import qualified	BishBosh.Data.Exception			as Data.Exception import qualified	BishBosh.Input.Verbosity		as Input.Verbosity import qualified	BishBosh.Property.SelfValidating	as Property.SelfValidating import qualified	BishBosh.Type.Count			as Type.Count+import qualified	Control.Exception+import qualified	Data.Default import qualified	System.FilePath  -- | Container for all command-line options.@@ -77,7 +77,7 @@  instance Property.SelfValidating.SelfValidating Options where 	findInvalidity	= Property.SelfValidating.findErrors [-		((/= Attribute.LogicalColour.nDistinctLogicalColours) . fromIntegral . length . getInputConfigFilePaths,	"There must be exactly one configuration file for White & one for Black.")+		((/= Colour.LogicalColour.nDistinctLogicalColours) . fromIntegral . length . getInputConfigFilePaths,	"There must be exactly one configuration file for White & one for Black.") 	 ]  -- | Mutator.@@ -109,7 +109,7 @@ appendInputConfigFilePath s options 	| fromIntegral ( 		length inputConfigFilePaths-	) == Attribute.LogicalColour.nDistinctLogicalColours	= Control.Exception.throw . Data.Exception.mkRedundantData . showString "Duel.Data.Options:\texactly " . shows Attribute.LogicalColour.nDistinctLogicalColours . showString " file-paths are required:\t" $ shows inputConfigFilePaths "."+	) == Colour.LogicalColour.nDistinctLogicalColours	= Control.Exception.throw . Data.Exception.mkRedundantData . showString "Duel.Data.Options:\texactly " . shows Colour.LogicalColour.nDistinctLogicalColours . showString " file-paths are required:\t" $ shows inputConfigFilePaths "." 	| otherwise						= options { getInputConfigFilePaths = s : inputConfigFilePaths } 	where 		inputConfigFilePaths	= getInputConfigFilePaths options

@@ -44,7 +44,7 @@  import			Control.Arrow((&&&), (|||)) import			Control.Category((>>>))-import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour+import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour import qualified	BishBosh.Data.Exception			as Data.Exception import qualified	BishBosh.Input.CommandLineOption	as Input.CommandLineOption import qualified	BishBosh.Input.IOOptions		as Input.IOOptions@@ -62,7 +62,6 @@ 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.Mass			as Type.Mass import qualified	BishBosh.UI.Command			as UI.Command import qualified	BishBosh.UI.ReportObject		as UI.ReportObject import qualified	Control.Exception@@ -118,9 +117,9 @@ -- | Read either a move or a game-termination reason from the specified handle. readMove 	:: Input.Verbosity.Verbosity-	-> Type.Count.NSeconds				-- ^ Read-timout.-	-> Attribute.LogicalColour.LogicalColour	-- ^ Whose turn it is.-	-> System.IO.Handle				-- ^ Output handle from which data should be read.+	-> Type.Count.NSeconds			-- ^ Read-timout.+	-> Colour.LogicalColour.LogicalColour	-- ^ Whose turn it is.+	-> System.IO.Handle			-- ^ Output handle from which data should be read. 	-> IO (Either Rule.GameTerminationReason.GameTerminationReason MoveNotation) readMove verbosity readTimeout logicalColour stdOut = do 	Control.Monad.when (verbosity == maxBound) . IO.Logger.printInfo . showString "Waiting " . (@@ -150,10 +149,10 @@ -- | Read either a move from the first handle & write it to the second. copyMove 	:: Input.Verbosity.Verbosity-	-> Type.Count.NSeconds				-- ^ Read-timout.-	-> Attribute.LogicalColour.LogicalColour	-- ^ Whose turn it is.-	-> System.IO.Handle				-- ^ Output handle from which move should be read.-	-> System.IO.Handle				-- ^ Input handle to which move should be forwarded.+	-> Type.Count.NSeconds			-- ^ Read-timout.+	-> Colour.LogicalColour.LogicalColour	-- ^ Whose turn it is.+	-> System.IO.Handle			-- ^ Output handle from which move should be read.+	-> System.IO.Handle			-- ^ Input handle to which move should be forwarded. 	-> IO (Maybe Rule.GameTerminationReason.GameTerminationReason) copyMove verbosity readTimeout logicalColour stdOut stdIn = do 	readMove verbosity readTimeout logicalColour stdOut >>= return {-to IO-monad-} . Just ||| (@@ -331,9 +330,7 @@ 							] configFilePath 							>>> HXT.arr ( 								\inputOptions -> (-									Input.SearchOptions.identifyAutomatedPlayers $ Input.Options.getSearchOptions (-										inputOptions	:: Input.Options.Options Type.Mass.PieceSquareValue	-- Arbitrary concrete type.-									),+									Input.SearchOptions.identifyAutomatedPlayers $ Input.Options.getSearchOptions inputOptions, 									Input.UIOptions.getMoveNotation . Input.IOOptions.getUIOptions $ Input.Options.getIOOptions inputOptions, 									null . Input.IOOptions.getPGNOptionsList $ Input.Options.getIOOptions inputOptions 								)

@@ -90,12 +90,9 @@ #endif  #ifdef USE_UNIX-import qualified	BishBosh.Concurrent.SignalHandlers	as Concurrent.SignalHandlers+import qualified	BishBosh.Concurrent.SignalHandlers			as Concurrent.SignalHandlers #endif --- Define concrete types to resolve the underlying polymorphic functions.-type Options	= Input.Options.Options Type.Mass.PieceSquareValue- writeXMLToFile 	:: HXT.XmlPickler pickleable 	=> System.FilePath.FilePath	-- ^ Destination.@@ -152,7 +149,7 @@ 		optDescrList :: [ 			G.OptDescr ( 				Maybe (Input.CommandLineOption.Flag, Maybe String {-optional value-}),	-- Record command-line specifications.-				Input.CommandLineOption.CommandLineOption Options			-- Defines the action to take on receipt of a command-line option.+				Input.CommandLineOption.CommandLineOption Input.Options.Options			-- Defines the action to take on receipt of a command-line option. 			) -- Pair. 		 ] 		optDescrList	= [@@ -235,12 +232,12 @@ 			defaultRandomSeed	= 0  -- Unary options-mutators.-			setPrintMoveTree, setVerbosity, setOutputConfigFilePath	:: String -> Input.CategorisedCommandLineOptions.OptionsMutator Options+			setPrintMoveTree, setVerbosity, setOutputConfigFilePath	:: String -> Input.CategorisedCommandLineOptions.OptionsMutator Input.Options.Options 			setPrintMoveTree	= Input.Options.setMaybePrintMoveTree . Just . Input.CommandLineOption.readArg 			setVerbosity		= Input.Options.setVerbosity . Input.CommandLineOption.readArg 			setOutputConfigFilePath	= Input.Options.setMaybeOutputConfigFilePath . Just -			setRandomSeed :: Maybe String -> Input.CategorisedCommandLineOptions.OptionsMutator Options+			setRandomSeed :: Maybe String -> Input.CategorisedCommandLineOptions.OptionsMutator Input.Options.Options 			setRandomSeed	= Input.Options.setMaybeRandomSeed . Just . Data.Maybe.maybe defaultRandomSeed Input.CommandLineOption.readBoundedIntegral  -- Nullary I/O-actions.@@ -259,14 +256,14 @@ 				showsVersion :: Data.Version.Version -> ShowS 				showsVersion	= foldr (.) id . Data.List.intersperse (showChar '.') . map shows . Data.Version.versionBranch -			checkPickler	= Control.Monad.void . HXT.runX $ HXT.constA (Data.Default.def :: Options) >>> HXT.checkPickler HXT.xpickle+			checkPickler	= Control.Monad.void . HXT.runX $ HXT.constA (Data.Default.def :: Input.Options.Options) >>> HXT.checkPickler HXT.xpickle  			generateDTD :: Maybe String -> Input.CategorisedCommandLineOptions.IOAction-			generateDTD hxtTraceLevel	= Control.Monad.void . HXT.runX $ HXT.constA (undefined :: Options) >>> HXT.xpickleWriteDTD HXT.xpickle [+			generateDTD hxtTraceLevel	= Control.Monad.void . HXT.runX $ HXT.constA (undefined :: Input.Options.Options) >>> HXT.xpickleWriteDTD HXT.xpickle [ 				HXT.withTrace $ Data.Maybe.maybe 0 Input.CommandLineOption.readBoundedIntegral hxtTraceLevel	-- Valid values in closed interval [0, 4] 			 ] "-" {-stdout-}	-- CAVEAT: this DTD requires manual correction of defaulted attributes, which are erroneously defined as 'REQUIRED' rather than 'IMPLIED'. -			formatPieceSquareTableForGNUPlot :: Input.CategorisedCommandLineOptions.ContextualIOAction Options+			formatPieceSquareTableForGNUPlot :: Input.CategorisedCommandLineOptions.ContextualIOAction Input.Options.Options 			formatPieceSquareTableForGNUPlot options	= Data.Maybe.maybe ( 				Control.Exception.throwIO $ Data.Exception.mkNullDatum "the piece-square table is undefined." 			 ) (@@ -275,17 +272,17 @@ 						\gamePhase	-> showChar Component.PieceSquareByCoordinatesByRank.gnuPlotComment . showString gamePhase . showString "-game:\n" 					) ["Opening", "End"] 				) $ map (-					\selector	-> Component.PieceSquareByCoordinatesByRank.formatForGNUPlot (+					\selector	-> Component.PieceSquareByCoordinatesByRank.formatForGNUPlot pieceSquareByCoordinatesByRank ( 						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'.+							realToFrac	:: Type.Mass.PieceSquareValue -> Input.PieceSquareTable.IOFormat 						) 					) ( 						showChar '\t'	-- Column-delimiter. 					) ( 						! selector Component.PieceSquareByCoordinatesByRank.nPiecesBounds	-- Select from interpolated values.-					) pieceSquareByCoordinatesByRank+					) 				) [snd, fst] 			 ) . Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank $ Input.Options.getEvaluationOptions options @@ -332,9 +329,9 @@ 							hxtTraceLevel :: Int 							hxtTraceLevel	= fromEnum preVerbosity `min` 2	{-CAVEAT: HXT trace-levels 3 & 4 are too verbose-} -							processInputOptions :: Options -> IO Options+							processInputOptions :: Input.Options.Options -> IO Input.Options.Options 							processInputOptions options	= let-								options' :: Options+								options' :: Input.Options.Options 								options'	= ( 									\o -> ( 										if Data.Maybe.isNothing . Input.IOOptions.getMaybePersistence $ Input.Options.getIOOptions o@@ -428,7 +425,7 @@ 									) ( 										\absolutePGNDatabaseFilePath -> either ( 											Control.Exception.throw . Data.Exception.mkParseFailure-										) id `fmap` ContextualNotation.PGNDatabase.parseIO absolutePGNDatabaseFilePath (+										) id <$> ContextualNotation.PGNDatabase.parseIO absolutePGNDatabaseFilePath ( 											Input.PGNOptions.getMaybeDecompressor pgnOptions 										) ( 											Input.PGNOptions.getIsStrictlySequential pgnOptions@@ -449,7 +446,7 @@ 								 ) Property.Empty.empty {-QualifiedMoveForest-} (Input.IOOptions.getPGNOptionsList ioOptions)  								let-									maybeApplicationTerminationReason	= State.PlayState.getMaybeApplicationTerminationReason (playState :: State.PlayState.PlayState Type.Mass.PieceSquareValue Type.Crypto.PositionHash)+									maybeApplicationTerminationReason	= State.PlayState.getMaybeApplicationTerminationReason (playState :: State.PlayState.PlayState 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) "."

@@ -1,76 +0,0 @@-{--	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- )-

@@ -1,159 +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@]	Defines the physical colour used to represent each component of the board.--}--module BishBosh.Attribute.ColourScheme (--- * Types--- ** Data-types-	ColourScheme(---		MkColourScheme,-		getDarkPieceColour,-		getLightPieceColour,-		getDarkSquareColour,-		getLightSquareColour-	),--- * Constants-	tag,---	darkSquareColourTag,---	lightSquareColourTag,---	darkPieceColourTag,---	lightPieceColourTag,--- * Functions--- ** Constructor---	mkColourScheme-) where--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-import qualified	Control.Exception-import qualified	Data.Default-import qualified	Text.XML.HXT.Arrow.Pickle		as HXT---- | Used to qualify XML.-tag :: String-tag	= "colourScheme"--darkPieceColourTag, darkSquareColourTag, lightPieceColourTag, lightSquareColourTag :: String-[darkPieceColourTag, darkSquareColourTag, lightPieceColourTag, lightSquareColourTag]	= [showString brightness $ showString component "Colour" | brightness <- ["dark", "light"], component <- ["Piece", "Square"]] -- List-comprehension.---- | Defines the command-line options.-data ColourScheme	= MkColourScheme {-	getDarkPieceColour	:: Attribute.PhysicalColour.PhysicalColour,	-- ^ The physical colour of the dark pieces.-	getLightPieceColour	:: Attribute.PhysicalColour.PhysicalColour,	-- ^ The physical colour of the light pieces.-	getDarkSquareColour	:: Attribute.PhysicalColour.PhysicalColour,	-- ^ The physical colour of the dark squares of the board.-	getLightSquareColour	:: Attribute.PhysicalColour.PhysicalColour	-- ^ The physical colour of the light squares of the board.-} deriving Eq--instance Control.DeepSeq.NFData ColourScheme where-	rnf MkColourScheme {-		getDarkPieceColour	= darkPieceColour,-		getLightPieceColour	= lightPieceColour,-		getDarkSquareColour	= darkSquareColour,-		getLightSquareColour	= lightSquareColour-	} = Control.DeepSeq.rnf (-		darkPieceColour,-		lightPieceColour,-		darkSquareColour,-		lightSquareColour-	 )--instance Show ColourScheme where-	showsPrec _ MkColourScheme {-		getDarkPieceColour	= darkPieceColour,-		getLightPieceColour	= lightPieceColour,-		getDarkSquareColour	= darkSquareColour,-		getLightSquareColour	= lightSquareColour-	} = Text.ShowList.showsAssociationList' $ map (Control.Arrow.second shows) [-		(-			darkPieceColourTag,-			darkPieceColour-		), (-			lightPieceColourTag,-			lightPieceColour-		), (-			darkSquareColourTag,-			darkSquareColour-		), (-			lightSquareColourTag,-			lightSquareColour-		)-	 ]--instance Data.Default.Default ColourScheme where-	def = MkColourScheme {-		getDarkPieceColour	= Attribute.PhysicalColour.blue,-		getLightPieceColour	= Property.Opposable.getOpposite $ getDarkPieceColour Data.Default.def,-		getDarkSquareColour	= Attribute.PhysicalColour.black,-		getLightSquareColour	= Property.Opposable.getOpposite $ getDarkSquareColour Data.Default.def-	}--instance HXT.XmlPickler ColourScheme where-	xpickle	= HXT.xpElem tag . HXT.xpWrap (-		\(a, b, c, d) -> mkColourScheme a b c d,	-- Construct.-		\MkColourScheme {-			getDarkPieceColour	= darkPieceColour,-			getLightPieceColour	= lightPieceColour,-			getDarkSquareColour	= darkSquareColour,-			getLightSquareColour	= lightSquareColour-		} -> (-			darkPieceColour,-			lightPieceColour,-			darkSquareColour,-			lightSquareColour-		) -- Deconstruct.-	 ) $ HXT.xp4Tuple (-		getDarkPieceColour def `HXT.xpDefault` HXT.xpAttr darkPieceColourTag HXT.xpickle-	 ) (-		getLightPieceColour def `HXT.xpDefault` HXT.xpAttr lightPieceColourTag HXT.xpickle-	 ) (-		getDarkSquareColour def `HXT.xpDefault` HXT.xpAttr darkSquareColourTag HXT.xpickle-	 ) (-		getLightSquareColour def `HXT.xpDefault` HXT.xpAttr lightSquareColourTag HXT.xpickle-	 ) where-		def :: ColourScheme-		def	= Data.Default.def---- | Smart constructor.-mkColourScheme-	:: Attribute.PhysicalColour.PhysicalColour	-- ^ Dark piece.-	-> Attribute.PhysicalColour.PhysicalColour	-- ^ Light piece.-	-> Attribute.PhysicalColour.PhysicalColour	-- ^ Dark square.-	-> Attribute.PhysicalColour.PhysicalColour	-- ^ Light square.-	-> ColourScheme-mkColourScheme darkPieceColour lightPieceColour darkSquareColour lightSquareColour-	| darkPieceColour `elem` bgColours		= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Attribute.ColourScheme.mkColourScheme:\t" . showString darkPieceColourTag . Text.ShowList.showsAssociation . shows darkPieceColour . showString " must differ from the physical colour of both squares; " $ shows bgColours "."-	| lightPieceColour `elem` bgColours		= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Attribute.ColourScheme.mkColourScheme:\t" . showString lightPieceColourTag . Text.ShowList.showsAssociation . shows lightPieceColour . showString " must differ from the physical colour of both squares; " $ shows bgColours "."-	| darkSquareColour == lightSquareColour		= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Attribute.ColourScheme.mkColourScheme:\tthe physical colours of " . shows lightSquareColourTag . showString " & " $ shows darkSquareColourTag ", must differ."-	| otherwise					= MkColourScheme {-		getDarkPieceColour	= darkPieceColour,-		getLightPieceColour	= lightPieceColour,-		getDarkSquareColour	= darkSquareColour,-		getLightSquareColour	= lightSquareColour-	}-	where-		bgColours	= [darkSquareColour, lightSquareColour]-

@@ -1,265 +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@]--	* Describes a /direction/ in two parts; the sense of change in the /x/-coordinate & the sense of change in the /y/-coordinate.--	* The IO-format uses a more concise & familiar format based on 8 points of the compass.--	* CAVEAT: this separation of /direction/ into orthogonal components is driven by the typical use-case,-	but requires that one guards against accidental construction of a degenerate 9th /direction/ which defines a change in neither direction.--}--module BishBosh.Attribute.Direction(--- * Types--- ** Type-synonyms-	ArrayByDirection,--- ** Data-types-	Direction(---		MkDirection,-		getXDirection,-		getYDirection-	),--- * Constants-	nw,-	n,-	ne,-	w,-	e,-	sw,-	s,-	se,-	tag,-	nDistinctDirections,-	parallels,-	diagonals,---	range,-	opposites,--- * Functions---	getOpposite,-	advanceDirection,-	attackDirectionsForPawn,-	listArrayByDirection,--- ** Constructor-	mkDirection,--- ** Predicates-	areAligned-) where--import			Control.Arrow((&&&))-import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour-import qualified	BishBosh.Data.Exception			as Data.Exception-import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership-import qualified	BishBosh.Property.Opposable		as Property.Opposable-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	Control.DeepSeq-import qualified	Control.Exception-import qualified	Data.Array.IArray-import qualified	Data.List.Extra-import qualified	Text.XML.HXT.Arrow.Pickle		as HXT-import qualified	Text.XML.HXT.Arrow.Pickle.Schema---- | Used to qualify XML.-tag :: String-tag	= "direction"---- | Constant direction.-nw :: Direction-nw	= MkDirection LT GT---- | Constant direction.-n :: Direction-n	= MkDirection EQ GT---- | Constant direction.-ne :: Direction-ne	= MkDirection GT GT---- | Constant direction.-w :: Direction-w	= MkDirection LT EQ---- | Constant direction.-e :: Direction-e	= MkDirection GT EQ---- | Constant direction.-sw :: Direction-sw	= MkDirection LT LT---- | Constant direction.-s :: Direction-s	= MkDirection EQ LT---- | Constant direction.-se :: Direction-se	= MkDirection GT LT---- | 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.-} deriving (Eq, Ord)--instance Bounded Direction where-	minBound	= sw-	maxBound	= ne--instance Control.DeepSeq.NFData Direction where-	rnf MkDirection {-		getXDirection	= xDirection,-		getYDirection	= yDirection-	} = xDirection `seq` yDirection `seq` ()--instance Show Direction where-	showsPrec _ MkDirection {-		getXDirection	= xDirection,-		getYDirection	= yDirection-	} = (-		case yDirection of-			LT	-> showChar 'S'-			EQ	-> id-			GT	-> showChar 'N'-	 ) . (-		case xDirection of-			LT	-> showChar 'W'-			EQ	-> id-			GT	-> showChar 'E'-	 )--instance Read Direction where-	readsPrec _ ss	= let-		s'	= Data.List.Extra.trimStart ss-	 in case Data.List.Extra.upper s' of-		'S' : remainder	-> case remainder of-			'W' : _	-> [(sw, drop 2 s')]-			'E' : _	-> [(se, drop 2 s')]-			_	-> [(s, tail s')]-		'N' : remainder	-> case remainder of-			'W' : _	-> [(nw, drop 2 s')]-			'E' : _	-> [(ne, drop 2 s')]-			_	-> [(n, tail s')]-		'W' : _	-> [(w, tail s')]-		'E' : _	-> [(e, tail s')]-		_	-> []	-- No parse.--instance Property.Opposable.Opposable Direction where-	getOpposite MkDirection {-		getXDirection	= xDirection,-		getYDirection	= yDirection-	} = MkDirection {-		getXDirection	= Property.Opposable.getOpposite xDirection,-		getYDirection	= Property.Opposable.getOpposite yDirection-	}--instance Property.Orientated.Orientated Direction where-	isDiagonal MkDirection { getXDirection = xDirection, getYDirection = yDirection }	= xDirection /= EQ && yDirection /= EQ-	isParallel MkDirection { getXDirection = xDirection, getYDirection = yDirection }	= xDirection == EQ || yDirection == EQ-	isStraight										= const True--instance Property.Reflectable.ReflectableOnX Direction where-	reflectOnX direction@MkDirection { getYDirection = yDirection }	= direction {-		getYDirection	= Property.Opposable.getOpposite yDirection-	}--instance Property.Reflectable.ReflectableOnY Direction where-	reflectOnY direction@MkDirection { getXDirection = xDirection }	= direction {-		getXDirection	= Property.Opposable.getOpposite xDirection-	}--instance HXT.XmlPickler Direction where-	xpickle	= HXT.xpWrap (read, show) . HXT.xpAttr tag . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range--instance Data.Array.IArray.Ix Direction where-	range (lower, upper)						= Control.Exception.assert (lower == minBound && upper == maxBound) Property.FixedMembership.members-	inRange (lower, upper) _					= Control.Exception.assert (lower == minBound && upper == maxBound) True-	index (lower, upper) (MkDirection xDirection yDirection)	= Control.Exception.assert (lower == minBound && upper == maxBound) $ case xDirection of-		LT	-> case yDirection of-			LT	-> 0-			EQ	-> 1-			GT	-> 2-		EQ	-> case yDirection of-			LT	-> 3-			EQ	-> Control.Exception.throw $ Data.Exception.mkResultUndefined "BishBosh.Attribute.Direction.index:\tundefined direction."-			GT	-> 4-		GT	-> case yDirection of-			LT	-> 5-			EQ	-> 6-			GT	-> 7---- | The ordered /direction/s in which /royalty/ can move.-range :: [Direction]-range	= [sw, w, nw, s, n, se, e, ne]--instance Property.FixedMembership.FixedMembership Direction where-	members	= range---- | Smart constructor.-mkDirection-	:: Ordering	-- ^ The sense of the change in the /x/-coordinate.-	-> Ordering	-- ^ The sense of the change in the /y/-coordinate.-	-> Direction-mkDirection EQ EQ			= Control.Exception.throw $ Data.Exception.mkResultUndefined "BishBosh.Attribute.Direction.mkDirection:\till-defined."-mkDirection xDirection yDirection	= MkDirection xDirection yDirection---- | The ordered /direction/s in which a @Rook@ can move.-parallels :: [Direction]-parallels	= [w, s, n, e]---- | The ordered /direction/s in which a @Bishop@ can move.-diagonals :: [Direction]-diagonals	= [sw, nw, se, ne]---- | The constant number of distinct /direction/s.-nDistinctDirections :: Type.Count.NDirections-nDistinctDirections	= fromIntegral $ length range--{- |-	* Returns a list of /direction/s, each paired with its anti-parallel.--	* CAVEAT: each /direction/ only appears once in the list, on an arbitrary side of a pair.--}-opposites :: [(Direction, Direction)]-opposites	= map (id &&& Property.Opposable.getOpposite) [sw, w, nw, s]---- | The /y/-direction in which a @Pawn@ of the specified /logical colour/ advances.-advanceDirection :: Attribute.LogicalColour.LogicalColour -> Ordering-advanceDirection Attribute.LogicalColour.Black	= LT	-- Black moves down.-advanceDirection _				= GT	-- White moves up.---- | The /direction/s in which a @Pawn@ can attack.-attackDirectionsForPawn :: Attribute.LogicalColour.LogicalColour -> [Direction]-attackDirectionsForPawn logicalColour	= map (`MkDirection` advanceDirection logicalColour) [LT, GT]---- | Whether the two /direction/s specified, are either parallel or anti-parallel.-areAligned :: Direction -> Direction -> Bool-areAligned direction	= uncurry (||) . ((== direction) &&& (== Property.Opposable.getOpposite direction))---- | A boxed array indexed by /direction/, of arbitrary elements.-type ArrayByDirection	= Data.Array.IArray.Array {-Boxed-} Direction---- | Array-constructor.-listArrayByDirection :: Data.Array.IArray.IArray a e => [e] -> a Direction e-listArrayByDirection	= Data.Array.IArray.listArray (minBound, maxBound)-

@@ -1,144 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{--	Copyright (C) 2018 Dr. Alistair Ward--	This file is part of BishBosh.--	BishBosh is free software: you can redistribute it and/or modify-	it under the terms of the GNU General Public License as published by-	the Free Software Foundation, either version 3 of the License, or-	(at your option) any later version.--	BishBosh is distributed in the hope that it will be useful,-	but WITHOUT ANY WARRANTY; without even the implied warranty of-	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-	GNU General Public License for more details.--	You should have received a copy of the GNU General Public License-	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.--}-{- |- [@AUTHOR@]	Dr. Alistair Ward-- [@DESCRIPTION@]--	* Defines the data-type which represents the logical (rather than physical) colour of /piece/s & (conceptually) of the two players.--	* N.B.: conceptually different from the logical colour of squares on the board.--}--module BishBosh.Attribute.LogicalColour(--- * Types--- ** Type-synonyms-	ArrayByLogicalColour,-	UArrayByLogicalColour,--- ** Data-types-	LogicalColour(..),--- * Constants-	tag,-	range,-	nDistinctLogicalColours,--- * Functions--- ** Constructor-	listArrayByLogicalColour,-	arrayByLogicalColour,--- ** Predicates-	isBlack---	isWhite-) where--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	Control.DeepSeq-import qualified	Control.Exception-import qualified	Data.Array.IArray-import qualified	Data.Array.Unboxed-import qualified	Data.List.Extra-import qualified	Text.XML.HXT.Arrow.Pickle			as HXT-import qualified	Text.XML.HXT.Arrow.Pickle.Schema---- | Used to qualify XML.-tag :: String-tag	= "logicalColour"---- | The sum-type of /logical colour/s associated with either a piece, or (conceptually) a player.-data LogicalColour-	= Black-	| White-	deriving (-		Bounded,-		Enum,-		Eq,-		Ord,-		Read,-		Show-	)--instance Control.DeepSeq.NFData LogicalColour where-	rnf _	= ()--instance Data.Array.IArray.Ix LogicalColour where-	range (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) range-	inRange (lower, upper) logicalColour	= Control.Exception.assert (logicalColour >= lower && logicalColour <= upper) True-	index (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) . fromEnum---- | The constant ascending range of /logical colour/s.-range :: [LogicalColour]-range	= [minBound, maxBound]--instance Property.FixedMembership.FixedMembership LogicalColour where-	members	= range---- | The constant number of distinct /logical colour/s.-nDistinctLogicalColours :: Type.Count.NLogicalColours-nDistinctLogicalColours	= fromIntegral $ length range--instance HXT.XmlPickler LogicalColour where-	xpickle	= HXT.xpAttr tag . HXT.xpWrap (read, show) . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range--instance Property.Opposable.Opposable LogicalColour where-	getOpposite Black	= White-	getOpposite _		= Black--instance Property.ExtendedPositionDescription.ReadsEPD LogicalColour where-	readsEPD s	= case Data.List.Extra.trimStart s of-		'b' : remainder	-> [(Black, remainder)]-		'w' : remainder	-> [(White, remainder)]-		_		-> []--instance Property.ExtendedPositionDescription.ShowsEPD LogicalColour where-	showsEPD	= showChar . \case-		Black	-> 'b'-		White	-> 'w'--instance Property.ForsythEdwards.ReadsFEN LogicalColour--instance Property.ForsythEdwards.ShowsFEN LogicalColour---- | Whether the specified /logical colour/ is @Black@.-isBlack :: LogicalColour -> Bool-{-# INLINE isBlack #-}-isBlack Black	= True-isBlack _	= False---- | Whether the specified /logical colour/ is @White@.-isWhite :: LogicalColour -> Bool-isWhite	= not . isBlack---- | A boxed array indexed by /logical colour/, of arbitrary elements.-type ArrayByLogicalColour	= Data.Array.IArray.Array LogicalColour---- | An unboxed array indexed by /logical colour/, of fixed-size values.-type UArrayByLogicalColour	= Data.Array.Unboxed.UArray LogicalColour---- | Array-constructor from an ordered list of elements.-listArrayByLogicalColour :: Data.Array.IArray.IArray a e => [e] -> a LogicalColour e-listArrayByLogicalColour	= Data.Array.IArray.listArray (minBound, maxBound)---- | Array-constructor from an association-list.-arrayByLogicalColour :: Data.Array.IArray.IArray a e => [(LogicalColour, e)] -> a LogicalColour e-arrayByLogicalColour	= Data.Array.IArray.array (minBound, maxBound)-

@@ -1,59 +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@]--	* Defines the data-type which represents the logical (rather than physical) colour of the squares on a chess-board.--	* N.B.: conceptually different from the logical colour of pieces.--}--module BishBosh.Attribute.LogicalColourOfSquare(--- * Types--- ** Data-type-	LogicalColourOfSquare(),--- * Constants-	black,-	white,--- * Functions--- ** Predicate-	isBlack-) where--import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour---- | The logical colour of a square of the board, cf. of a piece or (conceptually) of a player.-newtype LogicalColourOfSquare	= MkLogicalColourOfSquare {-	deconstruct	:: Attribute.LogicalColour.LogicalColour-} deriving (Eq, Bounded)---- | Constant.-black :: LogicalColourOfSquare-black	= MkLogicalColourOfSquare Attribute.LogicalColour.Black---- | Constant.-white :: LogicalColourOfSquare-white	= MkLogicalColourOfSquare Attribute.LogicalColour.White---- | Whether the specified /logical colour/ is @Black@.-isBlack :: LogicalColourOfSquare -> Bool-isBlack MkLogicalColourOfSquare { deconstruct = logicalColour }	= Attribute.LogicalColour.isBlack logicalColour-

@@ -45,7 +45,6 @@ -- ** Predicates 	isCastle, 	isEnPassant,---	isNormal, 	isCapture, 	isPromotion, 	isQuiet,@@ -53,7 +52,8 @@ 	isAcyclic, -- ** Query 	getMaybeExplicitlyTakenRank,-	getMaybeImplicitlyTakenRank+	getMaybeImplicitlyTakenRank,+	getMaybePromotedRank ) where  import qualified	BishBosh.Attribute.Rank			as Attribute.Rank@@ -210,11 +210,6 @@ isEnPassant EnPassant	= True isEnPassant _		= False --- | Whether the /move/ was neither @EnPassant@ nor @Castle@.-isNormal :: MoveType -> Bool-isNormal (Normal _ _)	= True-isNormal _		= False- -- | Whether a piece was captured, including @Pawn@s taken En-passant. isCapture :: MoveType -> Bool {-# INLINE isCapture #-}@@ -223,8 +218,7 @@  -- | Whether the /move/ includes @Pawn@-promotion. isPromotion :: MoveType -> Bool-isPromotion Normal { getMaybePromotionRank = Just _ }	= True-isPromotion _						= False+isPromotion = Data.Maybe.isJust . getMaybePromotedRank  -- | <https://www.chessprogramming.org/Quiet_Moves>. isQuiet :: MoveType -> Bool@@ -248,11 +242,7 @@ 	* CAVEAT: one can't infer from a negative result that the move can be repeated, since the mover may have been a @Pawn@. -} isAcyclic :: MoveType -> Bool-isAcyclic Normal {-	getMaybeTakenRank	= Nothing,-	getMaybePromotionRank	= Nothing-}		= False-isAcyclic _	= True+isAcyclic	= not . isSimple	-- Neither capture, promotion, castling nor en-passant can be repeated.  -- | Query whether a /piece/ was explicitly taken, excluding @Pawn@s taken En-passant. getMaybeExplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank@@ -263,6 +253,11 @@ getMaybeImplicitlyTakenRank :: MoveType -> Maybe Attribute.Rank.Rank getMaybeImplicitlyTakenRank EnPassant	= Just Attribute.Rank.Pawn getMaybeImplicitlyTakenRank moveType	= getMaybeExplicitlyTakenRank moveType++-- | Query the rank to which a piece was promoted.+getMaybePromotedRank :: MoveType -> Maybe Attribute.Rank.Rank+getMaybePromotedRank Normal { getMaybePromotionRank = maybePromotionRank }	= maybePromotionRank+getMaybePromotedRank _								= Nothing  -- | Returns the mutator required to adjust the number of pieces after a move. nPiecesMutator :: Enum nPieces => MoveType -> (nPieces -> nPieces)

@@ -1,119 +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@]--	* Defines the data-type which represents the physical (rather than logical) colour of the /board/ & of /piece/s.--	* The number of physical colours used to represent the /board/ & /piece/s can be greater than the two /logical colour/s required,-	but is limited in practice, since the terminal (optionally) used to render the image, typically can't cope with with a large number.--}--module BishBosh.Attribute.PhysicalColour(--- * Types--- ** Data-types-	PhysicalColour(),--- * Constants---	range,-	black,-	red,-	green,-	yellow,-	blue,-	magenta,-	cyan,-	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.--	* CAVEAT: the constructor-order both facilitates conversion to an ANSI Colour-code & the derivation of the complementary colour.--}-data PhysicalColour-	= Black-	| Red-	| Green-	| Yellow-	| Blue-	| Magenta-	| Cyan-	| White-	deriving (Enum, Eq, Read, Show)--instance Control.DeepSeq.NFData PhysicalColour where-	rnf _	= ()--instance Bounded PhysicalColour where-	minBound	= black-	maxBound	= white--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]--instance Property.FixedMembership.FixedMembership PhysicalColour where-	members	= range---- | Constant.-black :: PhysicalColour-black	= Black---- | Constant.-red :: PhysicalColour-red	= Red---- | Constant.-green :: PhysicalColour-green	= Green---- | Constant.-yellow :: PhysicalColour-yellow	= Yellow---- | Constant.-blue :: PhysicalColour-blue	= Blue---- | Constant.-magenta :: PhysicalColour-magenta	= Magenta---- | Constant.-cyan :: PhysicalColour-cyan	= Cyan---- | Constant.-white :: PhysicalColour-white	= White-

@@ -31,7 +31,6 @@ -- ** Type-synonyms 	EvaluateRank, 	ArrayByRank,-	UArrayByRank, -- ** Data-types 	Rank(..), -- * Constants@@ -64,7 +63,6 @@ import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Data.Array.IArray-import qualified	Data.Array.Unboxed import qualified	Data.Char import qualified	Data.List import qualified	Data.Ord@@ -208,9 +206,6 @@  -- | A boxed array indexed by /rank/, of arbitrary values. type ArrayByRank	= Data.Array.IArray.Array Rank---- | An unboxed array indexed by /rank/, of fixed-size values.-type UArrayByRank	= Data.Array.Unboxed.UArray Rank  -- | Array-constructor from an ordered list of elements. listArrayByRank :: Data.Array.IArray.IArray a e => [e] -> a Rank e

@@ -34,7 +34,9 @@ -- ** Type-synonyms --	Transformation, 	ArrayByCoordinates,---	UArrayByCoordinates,+#ifdef USE_UNBOXED_ARRAYS+	UArrayByCoordinates,+#endif -- * Constants 	tag, 	topLeft,@@ -45,6 +47,7 @@ -- * Functions --	extrapolate', 	extrapolate,+	applyAlongDirectionsFrom, 	interpolate, 	getLogicalColourOfSquare, 	kingsStartingCoordinates,@@ -61,12 +64,9 @@ --	maybeAdvance, 	retreat, 	maybeRetreat,---	rotate, -- ** Constructors 	mkCoordinates, 	mkMaybeCoordinates,---	toIx,-	fromIx, 	mkRelativeCoordinates, 	listArrayByCoordinates, 	arrayByCoordinates,@@ -79,32 +79,35 @@  import			Control.Arrow((&&&), (***)) import			Data.Array.IArray((!))-import qualified	BishBosh.Attribute.Direction			as Attribute.Direction-import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour-import qualified	BishBosh.Attribute.LogicalColourOfSquare	as Attribute.LogicalColourOfSquare-import qualified	BishBosh.Cartesian.Abscissa			as Cartesian.Abscissa-import qualified	BishBosh.Cartesian.Ordinate			as Cartesian.Ordinate-import qualified	BishBosh.Data.Exception				as Data.Exception-import qualified	BishBosh.Property.FixedMembership		as Property.FixedMembership-import qualified	BishBosh.Property.Opposable			as Property.Opposable-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	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa+import qualified	BishBosh.Cartesian.Ordinate		as Cartesian.Ordinate+import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour+import qualified	BishBosh.Colour.LogicalColourOfSquare	as Colour.LogicalColourOfSquare+import qualified	BishBosh.Direction.Direction		as Direction.Direction+import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable+import qualified	BishBosh.Property.Orientated		as Property.Orientated+import qualified	BishBosh.Property.Reflectable		as Property.Reflectable+import qualified	BishBosh.Property.Rotatable		as Property.Rotatable+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 import qualified	Data.Array.IArray-import qualified	Data.Array.Unboxed import qualified	Data.Foldable import qualified	Data.List-import qualified	Data.Map					as Map+import qualified	Data.Map				as Map import qualified	Data.Maybe  #ifdef USE_PARALLEL import qualified	Control.Parallel.Strategies #endif +#ifdef USE_UNBOXED_ARRAYS+import qualified	Data.Array.Unboxed+#endif+ -- | Used to qualify XML. tag :: String tag	= "coordinates"@@ -115,22 +118,6 @@ 	getY	:: ! Type.Length.Y	-- ^ Ordinate. } deriving Eq -instance Control.DeepSeq.NFData Coordinates where-	rnf MkCoordinates { getX = x, getY = y }	= Control.DeepSeq.rnf (x, y)--instance Show Coordinates where-	showsPrec precedence MkCoordinates { getX = x, getY = y }	= showsPrec precedence (x, y)--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 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 Bounded Coordinates where 	minBound = MkCoordinates { 		getX	= Cartesian.Abscissa.xMin,@@ -141,11 +128,48 @@ 		getY	= Cartesian.Ordinate.yMax 	} -- Top Right. +instance Control.DeepSeq.NFData Coordinates where+	rnf MkCoordinates { getX = x, getY = y }	= Control.DeepSeq.rnf (x, 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+	index (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) . fromEnum +instance Enum Coordinates where+	toEnum = (+		\(y, x) -> MkCoordinates {+			getX	= Cartesian.Abscissa.fromIx x,+			getY	= Cartesian.Ordinate.fromIx y+		}+	 ) . (`divMod` fromIntegral Cartesian.Abscissa.xLength)++	fromEnum MkCoordinates {+		getX	= x,+		getY	= y+	} = fromIntegral Cartesian.Abscissa.xLength * Cartesian.Ordinate.toIx y + Cartesian.Abscissa.toIx x++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 Show Coordinates where+	showsPrec precedence MkCoordinates { getX = x, getY = y }	= showsPrec precedence (x, y)++instance Read Coordinates where+	readsPrec precedence s	= [+		(coordinates, remainder) |+			(Just coordinates, remainder)	<- Control.Arrow.first (uncurry mkMaybeCoordinates) `map` readsPrec precedence s+	 ] -- List-comprehension.++instance Property.Opposable.Opposable Coordinates where+	getOpposite MkCoordinates {+		getX	= x,+		getY	= y+	} = MkCoordinates {+		getX	= Cartesian.Abscissa.reflect x,+		getY	= Cartesian.Ordinate.reflect y+	}+ instance Property.Reflectable.ReflectableOnX Coordinates where 	reflectOnX coordinates@MkCoordinates { getY = y }	= coordinates { getY = Cartesian.Ordinate.reflect y } @@ -153,9 +177,21 @@ 	reflectOnY coordinates@MkCoordinates { getX = x }	= coordinates { getX = Cartesian.Abscissa.reflect x }  instance Property.Rotatable.Rotatable Coordinates where-	rotate90	= rotate Attribute.Direction.w-	rotate180	= rotate Attribute.Direction.s-	rotate270	= rotate Attribute.Direction.e+	rotate90 MkCoordinates {+		getX	= x,+		getY	= y+	} = MkCoordinates {+		getX	= fromIntegral $! Cartesian.Ordinate.reflect y,+		getY	= fromIntegral x+	} -- +90 degrees, i.e. anti-clockwise.+	rotate180	= Property.Opposable.getOpposite+	rotate270 MkCoordinates {+		getX	= x,+		getY	= y+	} = MkCoordinates {+		getX	= fromIntegral y,+		getY	= fromIntegral $! Cartesian.Abscissa.reflect x+	} -- -90 degrees, i.e. clockwise.  -- | Constant. topLeft :: Coordinates@@ -208,32 +244,15 @@ 	| inBounds x y	= Just MkCoordinates { getX = x, getY = y } 	| otherwise	= Nothing --- | Convert to an array-index.-toIx :: Coordinates -> Int-toIx MkCoordinates {-	getX	= x,-	getY	= y-} = fromIntegral Cartesian.Abscissa.xLength * Cartesian.Ordinate.toIx y + Cartesian.Abscissa.toIx x--{- |-	* Construct from the specified array-index.--	* CAVEAT: assumes that the array is indexed by the whole range of /coordinates/.--}-fromIx :: Int -> Coordinates-fromIx	= (-	\(y, x) -> MkCoordinates {-		getX	= Cartesian.Abscissa.fromIx x,-		getY	= Cartesian.Ordinate.fromIx y-	}- ) . (`divMod` fromIntegral Cartesian.Abscissa.xLength)+-- | The type of a function which changes one set of /coordinates/ to another.+type Transformation	= Coordinates -> Coordinates  {- | 	* Translate the specified /coordinates/ using the specified mapping.  	* CAVEAT: the caller must ensure that the results are legal. -}-translate :: ((Type.Length.X, Type.Length.Y) -> (Type.Length.X, Type.Length.Y)) -> Coordinates -> Coordinates+translate :: ((Type.Length.X, Type.Length.Y) -> (Type.Length.X, Type.Length.Y)) -> Transformation translate transformation MkCoordinates { 	getX	= x, 	getY	= y@@ -259,7 +278,7 @@ 	:: (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+maybeTranslateX transformation coordinates@MkCoordinates { getX = x }	= (\x' -> coordinates { getX = x' }) <$> Cartesian.Abscissa.maybeTranslate transformation x  {- | 	* Translate the specified ordinate.@@ -274,7 +293,7 @@ 	:: (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+maybeTranslateY transformation coordinates@MkCoordinates { getY = y }	= (\y' -> coordinates { getY = y' }) <$> Cartesian.Ordinate.maybeTranslate transformation y  {- | 	* Construct /coordinates/ relative to 'minBound'.@@ -290,18 +309,18 @@ 	* CAVEAT: the caller must ensure that the results are legal. -} advance-	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.+	:: Colour.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance. 	-> Transformation-advance logicalColour	= translateY $ if Attribute.LogicalColour.isBlack logicalColour+advance logicalColour	= translateY $ if Colour.LogicalColour.isBlack logicalColour 	then pred 	else succ  -- | Where legal, move one step towards the opponent. maybeAdvance-	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.+	:: Colour.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+maybeAdvance logicalColour	= maybeTranslateY $ if Colour.LogicalColour.isBlack logicalColour 	then pred 	else succ @@ -311,13 +330,13 @@ 	* CAVEAT: the caller must ensure that the results are legal. -} retreat-	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.+	:: Colour.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-	:: Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.+	:: Colour.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@@ -328,24 +347,41 @@  -- | Generates a line of /coordinates/, starting just after the specified source & proceeding in the specified /direction/ to the edge of the board. extrapolate'-	:: Attribute.Direction.Direction	-- ^ The direction in which to proceed.-	-> Coordinates			-- ^ The point from which to start.+	:: Coordinates				-- ^ The point from which to start.+	-> Direction.Direction.Direction	-- ^ The direction in which to proceed. 	-> [Coordinates]-extrapolate' direction MkCoordinates {+extrapolate' MkCoordinates { 	getX	= x, 	getY	= y-} = zipWith MkCoordinates (-	case Attribute.Direction.getXDirection direction of-		GT	-> [succ x .. Cartesian.Abscissa.xMax]-		LT	-> let startX = pred x in startX `seq` [startX, pred startX .. Cartesian.Abscissa.xMin]-		EQ	-> repeat x- ) (-	case Attribute.Direction.getYDirection direction of-		GT	-> [succ y .. Cartesian.Ordinate.yMax]-		LT	-> let startY = pred y in startY `seq` [startY, pred startY .. Cartesian.Ordinate.yMin]-		EQ	-> repeat y- )+} direction = uncurry (zipWith MkCoordinates) $ if Property.Orientated.isParallel direction+	then if Property.Orientated.isVertical direction+		then doVertical+		else doHorizontal+	else doDiagonal+	where+		xIncreasing, xDecreasing :: [Type.Length.X]+		xIncreasing	= [succ x .. Cartesian.Abscissa.xMax]+		xDecreasing	= let startX = pred x in startX `seq` [startX, pred startX .. Cartesian.Abscissa.xMin] +		yIncreasing, yDecreasing :: [Type.Length.Y]+		yIncreasing	= [succ y .. Cartesian.Ordinate.yMax]+		yDecreasing	= let startY = pred y in startY `seq` [startY, pred startY .. Cartesian.Ordinate.yMin]++		doVertical, doHorizontal, doDiagonal :: ([Type.Length.X], [Type.Length.Y])+		doVertical	= (+			repeat x,+			if direction == Direction.Direction.s then yDecreasing else yIncreasing+		 ) -- Pair.+		doHorizontal	= (+			if direction == Direction.Direction.w then xDecreasing else xIncreasing,+			repeat y+		 ) -- Pair.+		doDiagonal+			| direction == Direction.Direction.sw	= (xDecreasing,	yDecreasing)+			| direction == Direction.Direction.se	= (xIncreasing,	yDecreasing)+			| direction == Direction.Direction.nw	= (xDecreasing,	yIncreasing)+			| otherwise {-NE-}			= (xIncreasing,	yIncreasing)+ {- | 	* Generates a line of /coordinates/, starting just after the specified source & proceeding in the specified /direction/ to the edge of the board. @@ -353,22 +389,34 @@ 	In consequence, it is typically automatically avoided using a rewrite-rule to lookup an array of the results from all possible calls. -} extrapolate-	:: Attribute.Direction.Direction	-- ^ The direction in which to proceed.-	-> Coordinates			-- ^ The point from which to start.+	:: Coordinates				-- ^ The point from which to start.+	-> Direction.Direction.Direction	-- ^ The direction in which to proceed. 	-> [Coordinates]-extrapolate direction coordinates	= extrapolationsByDirectionByCoordinates ! coordinates ! direction+extrapolate coordinates	direction	= extrapolationsByDirectionByCoordinates ! coordinates ! direction  -- | The constant lists of /coordinates/, extrapolated from every /coordinate/ in the /board/, in every /direction/.-extrapolationsByDirectionByCoordinates :: ArrayByCoordinates (Attribute.Direction.ArrayByDirection [Coordinates])+extrapolationsByDirectionByCoordinates :: ArrayByCoordinates (Direction.Direction.ArrayByDirection [Coordinates]) extrapolationsByDirectionByCoordinates	= listArrayByCoordinates #ifdef USE_PARALLEL 	. Control.Parallel.Strategies.withStrategy (Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq) #endif 	$ map (-		\coordinates	-> Attribute.Direction.listArrayByDirection $ map (`extrapolate'` coordinates) Property.FixedMembership.members-	) Property.FixedMembership.members+		\coordinates	-> Direction.Direction.listArrayByDirection $ extrapolate' coordinates `map` Property.FixedMembership.members {-direction-}+	) Property.FixedMembership.members {-coordinates-} --- | The list of /coordinates/, between every permutation of source & valid destination on the /board/.+-- | Apply the specified function to each line of /coordinates/ extrapolated from the specified central hub, in each of the specified /direction/s.+applyAlongDirectionsFrom+	:: ([Coordinates] -> [a])			-- ^ Individually map each straight line of coordinates extrapolated from the central hub.+	-> Coordinates					-- ^ The central hub from which to extrapolate.+	-> Maybe [Direction.Direction.Direction]	-- ^ The directions in which to extrapolate; 'Nothing' implies omnidirectional.+	-> [a]+applyAlongDirectionsFrom f from	= Data.Maybe.maybe (+	Data.Foldable.foldMap f $ extrapolationsByDirectionByCoordinates ! from -- Traverse all directions from this coordinate, without repeatedly converting direction to an array-index.+ ) (+	concatMap $ f . (extrapolationsByDirectionByCoordinates ! from !)+ )++-- | The constant lists of /coordinates/, between every permutation of source & valid destination on the /board/. interpolationsByDestinationBySource :: ArrayByCoordinates (Map.Map Coordinates [Coordinates]) interpolationsByDestinationBySource	= Data.Array.IArray.amap ( 	Map.fromList . map (@@ -386,40 +434,7 @@ 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	= 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 :: 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 yDistance',-		getY	= Cartesian.Ordinate.fromIx xDistance-	} -- +90 degrees, i.e. anti-clockwise.-	(EQ, LT)	-> MkCoordinates {-		getX	= Cartesian.Abscissa.fromIx xDistance',-		getY	= Cartesian.Ordinate.fromIx yDistance'-	} -- 180 degrees.-	(GT, EQ)	-> MkCoordinates {-		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	= 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/.  	* N.B.: this isn't the /irrational/ distance a rational crow would fly, but rather the integral /x/ & /y/ components of that path.@@ -439,42 +454,44 @@ } = (x' - x, y' - y)  -- | The /logical colour/ of the specified square.-getLogicalColourOfSquare :: Coordinates -> Attribute.LogicalColourOfSquare.LogicalColourOfSquare+getLogicalColourOfSquare :: Coordinates -> Colour.LogicalColourOfSquare.LogicalColourOfSquare getLogicalColourOfSquare coordinates 	| uncurry (==) . ( 		even *** even-	) $ measureDistance minBound coordinates	= Attribute.LogicalColourOfSquare.black-	| otherwise					= Attribute.LogicalColourOfSquare.white+	) $ measureDistance minBound coordinates	= Colour.LogicalColourOfSquare.black+	| otherwise					= Colour.LogicalColourOfSquare.white  -- | Whether the specified squares have the same /logical colour/. areSquaresIsochromatic :: [Coordinates] -> Bool areSquaresIsochromatic	= uncurry (||) . (all (== minBound) &&& all (== maxBound)) . map getLogicalColourOfSquare  -- | The conventional starting /coordinates/ for the @King@ of the specified /logical colour/.-kingsStartingCoordinates :: Attribute.LogicalColour.LogicalColour -> Coordinates+kingsStartingCoordinates :: Colour.LogicalColour.LogicalColour -> Coordinates kingsStartingCoordinates logicalColour	= MkCoordinates { 	getX	= Cartesian.Abscissa.kingsFile, 	getY	= Cartesian.Ordinate.firstRank logicalColour }  -- | The conventional starting /coordinates/ for each @Rook@.-rooksStartingCoordinates :: Attribute.LogicalColour.LogicalColour -> [Coordinates]-rooksStartingCoordinates Attribute.LogicalColour.Black	= [topLeft, maxBound]+rooksStartingCoordinates :: Colour.LogicalColour.LogicalColour -> [Coordinates]+rooksStartingCoordinates Colour.LogicalColour.Black	= [topLeft, maxBound] rooksStartingCoordinates _				= [minBound, bottomRight]  -- | Whether the specified /coordinates/ are where a @Pawn@ of the specified /logical colour/ starts.-isPawnsFirstRank :: Attribute.LogicalColour.LogicalColour -> Coordinates -> Bool-isPawnsFirstRank logicalColour MkCoordinates { getY = y }	= y == Cartesian.Ordinate.pawnsFirstRank logicalColour+isPawnsFirstRank :: Coordinates -> Colour.LogicalColour.LogicalColour -> Bool+isPawnsFirstRank MkCoordinates { getY = y }	= (== y) . Cartesian.Ordinate.pawnsFirstRank  -- | Whether a @Pawn@ is currently on the appropriate /rank/ to take an opponent's @Pawn@ /en-passant/.-isEnPassantRank :: Attribute.LogicalColour.LogicalColour -> Coordinates -> Bool-isEnPassantRank logicalColour MkCoordinates { getY = y }	= y == Cartesian.Ordinate.enPassantRank logicalColour+isEnPassantRank :: Coordinates -> Colour.LogicalColour.LogicalColour -> Bool+isEnPassantRank MkCoordinates { getY = y }	= (== y) . Cartesian.Ordinate.enPassantRank  -- | A boxed array indexed by /coordinates/, of arbitrary elements. type ArrayByCoordinates	= Data.Array.IArray.Array Coordinates +#ifdef USE_UNBOXED_ARRAYS -- | An unboxed array indexed by /coordinates/, of fixed-size elements. type UArrayByCoordinates	= Data.Array.Unboxed.UArray Coordinates+#endif  -- | Array-constructor from an ordered list of elements. listArrayByCoordinates :: Data.Array.IArray.IArray a e => [e] -> a Coordinates e

@@ -49,10 +49,10 @@ 	inBounds ) where -import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour-import qualified	BishBosh.Cartesian.Abscissa		as Cartesian.Abscissa-import qualified	BishBosh.Property.Opposable		as Property.Opposable-import qualified	BishBosh.Type.Length			as Type.Length+import qualified	BishBosh.Cartesian.Abscissa	as Cartesian.Abscissa+import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour+import qualified	BishBosh.Property.Opposable	as Property.Opposable+import qualified	BishBosh.Type.Length		as Type.Length import qualified	Control.Exception  -- | The constant length of the /y/-axis.@@ -79,24 +79,24 @@ fromIx	= (+ yMin) . fromIntegral  -- | The /rank/ from which /piece/s conventionally start.-firstRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y-firstRank Attribute.LogicalColour.Black	= yMax+firstRank :: Colour.LogicalColour.LogicalColour -> Type.Length.Y+firstRank Colour.LogicalColour.Black	= yMax firstRank _				= yMin  -- | The final /rank/; i.e. the one on which a @Pawn@ is promoted.-lastRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y+lastRank :: Colour.LogicalColour.LogicalColour -> Type.Length.Y lastRank	= firstRank . Property.Opposable.getOpposite  -- | The /rank/ from which @Pawn@s conventionally start.-pawnsFirstRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y+pawnsFirstRank :: Colour.LogicalColour.LogicalColour -> Type.Length.Y {-# INLINE pawnsFirstRank #-}-pawnsFirstRank Attribute.LogicalColour.Black	= pred yMax+pawnsFirstRank Colour.LogicalColour.Black	= pred yMax pawnsFirstRank _				= succ yMin  -- | The /rank/ from which a @Pawn@ may capture /en-passant/.-enPassantRank :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y+enPassantRank :: Colour.LogicalColour.LogicalColour -> Type.Length.Y {-# INLINE enPassantRank #-}-enPassantRank Attribute.LogicalColour.Black	= fromIx 3+enPassantRank Colour.LogicalColour.Black	= fromIx 3 enPassantRank _					= fromIx 4  -- | Reflects about the mid-point of the axis.

@@ -41,23 +41,23 @@ 	measureDistance, -- ** Predicates --	hasDistance,-	isDiagonal,-	isParallel,-	isStraight, 	isPawnAttack, 	isKnightsMove, 	isKingsMove, 	matchesPawnDoubleAdvance ) where -import			Control.Arrow((&&&), (***))-import qualified	BishBosh.Attribute.Direction		as Attribute.Direction-import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour-import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates-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			Control.Arrow((***))+import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates+import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour+import qualified	BishBosh.Data.Exception		as Data.Exception+import qualified	BishBosh.Direction.Direction	as Direction.Direction+import qualified	BishBosh.Property.Opposable	as Property.Opposable+import qualified	BishBosh.Property.Orientated	as Property.Orientated+import qualified	BishBosh.Text.ShowList		as Text.ShowList+import qualified	BishBosh.Type.Length		as Type.Length import qualified	Control.DeepSeq+import qualified	Control.Exception  -- | The distance between two /coordinates/. data Vector	= MkVector {@@ -78,9 +78,19 @@ 	} = MkVector (negate xDistance) (negate yDistance)  instance Property.Orientated.Orientated Vector where-	isDiagonal	= isDiagonal-	isParallel	= isParallel+	isVertical MkVector { getXDistance = xDistance }	= xDistance == 0 +	isHorizontal MkVector { getYDistance = yDistance }	= yDistance == 0++	isParallel MkVector { getXDistance = 0 }	= True+	isParallel MkVector { getYDistance = 0 }	= True+	isParallel _					= False++	isDiagonal MkVector {+		getXDistance	= xDistance,+		getYDistance	= yDistance+	} = abs xDistance == fromIntegral (abs yDistance)+ -- | 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@@ -93,36 +103,17 @@ 	-> 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 :: 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 :: Vector -> Bool-{-# INLINE isParallel #-}-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 :: 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 :: Attribute.LogicalColour.LogicalColour -> [Vector]+attackVectorsForPawn :: Colour.LogicalColour.LogicalColour -> [Vector] attackVectorsForPawn logicalColour	= [ 	MkVector { 		getXDistance	= x, 		getYDistance	= (-			if Attribute.LogicalColour.isBlack logicalColour+			if Colour.LogicalColour.isBlack logicalColour 				then negate	-- Black moves down. 				else id		-- White moves up. 		) 1@@ -155,12 +146,12 @@  	* 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 :: Attribute.LogicalColour.LogicalColour -> Vector -> Bool+isPawnAttack :: Vector -> Colour.LogicalColour.LogicalColour -> Bool {-# INLINE isPawnAttack #-}-isPawnAttack logicalColour MkVector {+isPawnAttack MkVector { 	getXDistance	= xDistance, 	getYDistance	= yDistance-} = abs xDistance == 1 && yDistance == if Attribute.LogicalColour.isBlack logicalColour+} logicalColour = abs xDistance == 1 && yDistance == if Colour.LogicalColour.isBlack logicalColour 	then negate 1 	else 1 @@ -189,34 +180,54 @@  	* 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 :: Attribute.LogicalColour.LogicalColour -> Vector -> Bool-matchesPawnDoubleAdvance logicalColour MkVector {+matchesPawnDoubleAdvance :: Vector -> Colour.LogicalColour.LogicalColour -> Bool+matchesPawnDoubleAdvance MkVector { 	getXDistance	= 0, 	getYDistance	= yDistance-}				= yDistance == if Attribute.LogicalColour.isBlack logicalColour then negate 2 else 2+} logicalColour			= yDistance == if Colour.LogicalColour.isBlack logicalColour then negate 2 else 2 matchesPawnDoubleAdvance _ _	= False  -- | Translate the specified /coordinates/ by the specified /vector/.-translate :: Cartesian.Coordinates.Coordinates -> Vector -> Cartesian.Coordinates.Coordinates-translate coordinates MkVector {+translate :: Vector -> Cartesian.Coordinates.Coordinates -> Cartesian.Coordinates.Coordinates+translate MkVector { 	getXDistance	= xDistance, 	getYDistance	= yDistance-} = Cartesian.Coordinates.translate ((+ xDistance) *** (+ yDistance)) coordinates+} = Cartesian.Coordinates.translate $ (+ xDistance) *** (+ yDistance)  -- | Where legal, translate the specified /coordinates/ by the specified /vector/.-maybeTranslate :: Cartesian.Coordinates.Coordinates -> Vector -> Maybe Cartesian.Coordinates.Coordinates-maybeTranslate coordinates MkVector {+maybeTranslate :: Vector -> Cartesian.Coordinates.Coordinates -> Maybe Cartesian.Coordinates.Coordinates+maybeTranslate MkVector { 	getXDistance	= xDistance, 	getYDistance	= yDistance-} = Cartesian.Coordinates.maybeTranslate ((+ xDistance) *** (+ yDistance)) coordinates+} = Cartesian.Coordinates.maybeTranslate $ (+ xDistance) *** (+ yDistance)  {- | 	* 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 :: Vector -> Maybe Attribute.Direction.Direction-toMaybeDirection vector@(MkVector xDistance yDistance)-	| isStraight vector	= Just $ Attribute.Direction.mkDirection (xDistance `compare` 0) (yDistance `compare` 0)-	| otherwise		= Nothing+toMaybeDirection :: Vector -> Maybe Direction.Direction.Direction+toMaybeDirection vector@(MkVector xDistance yDistance)	= case (xDistance `compare` 0, yDistance `compare` 0) of+	(LT, ySense)	-> case ySense of+		LT+			| xDistance == yDistance'		-> Just Direction.Direction.sw+			| otherwise				-> Nothing+		EQ						-> Just Direction.Direction.w+		GT+			| negate xDistance == yDistance'	-> Just Direction.Direction.nw+			| otherwise				-> Nothing+	(EQ, ySense)	-> Just $ case ySense of+		LT	-> Direction.Direction.s+		EQ	-> Control.Exception.throw . Data.Exception.mkRequestFailure . showString "BishBosh.Cartesian.Vector.toMaybeDirection:\tundefined direction" . Text.ShowList.showsAssociation $ shows vector "."+		GT	-> Direction.Direction.n+	(GT, ySense)	-> case ySense of+		LT+			| xDistance == negate yDistance'	-> Just Direction.Direction.se+			| otherwise				-> Nothing+		EQ						-> Just Direction.Direction.e+		GT+			| xDistance == yDistance'		-> Just Direction.Direction.ne+			| otherwise				-> Nothing+	where+		yDistance'	= fromIntegral yDistance 

@@ -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.Colour.ANSIColourCode(+-- * Types+-- ** Type-synonyms+--	ANSIColourCode(),+--	IsBold,+	GraphicsRendition,+-- * Functions+	selectGraphicsRendition,+	bracket,+-- ** Constructors+	mkFgColourCode,+	mkBgColourCode+) where++import qualified	BishBosh.Colour.PhysicalColour	as Colour.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 :: Colour.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 :: Colour.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+ )+

@@ -0,0 +1,159 @@+{-+	Copyright (C) 2018 Dr. Alistair Ward++	This file is part of BishBosh.++	BishBosh is free software: you can redistribute it and/or modify+	it under the terms of the GNU General Public License as published by+	the Free Software Foundation, either version 3 of the License, or+	(at your option) any later version.++	BishBosh is distributed in the hope that it will be useful,+	but WITHOUT ANY WARRANTY; without even the implied warranty of+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+	GNU General Public License for more details.++	You should have received a copy of the GNU General Public License+	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@]	Dr. Alistair Ward++ [@DESCRIPTION@]	Defines the physical colour used to represent each component of the board.+-}++module BishBosh.Colour.ColourScheme (+-- * Types+-- ** Data-types+	ColourScheme(+--		MkColourScheme,+		getDarkPieceColour,+		getLightPieceColour,+		getDarkSquareColour,+		getLightSquareColour+	),+-- * Constants+	tag,+--	darkSquareColourTag,+--	lightSquareColourTag,+--	darkPieceColourTag,+--	lightPieceColourTag,+-- * Functions+-- ** Constructor+--	mkColourScheme+) where++import qualified	BishBosh.Colour.PhysicalColour	as Colour.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+import qualified	Control.Exception+import qualified	Data.Default+import qualified	Text.XML.HXT.Arrow.Pickle	as HXT++-- | Used to qualify XML.+tag :: String+tag	= "colourScheme"++darkPieceColourTag, darkSquareColourTag, lightPieceColourTag, lightSquareColourTag :: String+[darkPieceColourTag, darkSquareColourTag, lightPieceColourTag, lightSquareColourTag]	= [showString brightness $ showString component "Colour" | brightness <- ["dark", "light"], component <- ["Piece", "Square"]] -- List-comprehension.++-- | Defines the command-line options.+data ColourScheme	= MkColourScheme {+	getDarkPieceColour	:: Colour.PhysicalColour.PhysicalColour,	-- ^ The physical colour of the dark pieces.+	getLightPieceColour	:: Colour.PhysicalColour.PhysicalColour,	-- ^ The physical colour of the light pieces.+	getDarkSquareColour	:: Colour.PhysicalColour.PhysicalColour,	-- ^ The physical colour of the dark squares of the board.+	getLightSquareColour	:: Colour.PhysicalColour.PhysicalColour		-- ^ The physical colour of the light squares of the board.+} deriving Eq++instance Control.DeepSeq.NFData ColourScheme where+	rnf MkColourScheme {+		getDarkPieceColour	= darkPieceColour,+		getLightPieceColour	= lightPieceColour,+		getDarkSquareColour	= darkSquareColour,+		getLightSquareColour	= lightSquareColour+	} = Control.DeepSeq.rnf (+		darkPieceColour,+		lightPieceColour,+		darkSquareColour,+		lightSquareColour+	 )++instance Show ColourScheme where+	showsPrec _ MkColourScheme {+		getDarkPieceColour	= darkPieceColour,+		getLightPieceColour	= lightPieceColour,+		getDarkSquareColour	= darkSquareColour,+		getLightSquareColour	= lightSquareColour+	} = Text.ShowList.showsAssociationList' $ map (Control.Arrow.second shows) [+		(+			darkPieceColourTag,+			darkPieceColour+		), (+			lightPieceColourTag,+			lightPieceColour+		), (+			darkSquareColourTag,+			darkSquareColour+		), (+			lightSquareColourTag,+			lightSquareColour+		)+	 ]++instance Data.Default.Default ColourScheme where+	def = MkColourScheme {+		getDarkPieceColour	= Colour.PhysicalColour.blue,+		getLightPieceColour	= Property.Opposable.getOpposite $ getDarkPieceColour Data.Default.def,+		getDarkSquareColour	= Colour.PhysicalColour.black,+		getLightSquareColour	= Property.Opposable.getOpposite $ getDarkSquareColour Data.Default.def+	}++instance HXT.XmlPickler ColourScheme where+	xpickle	= HXT.xpElem tag . HXT.xpWrap (+		\(a, b, c, d) -> mkColourScheme a b c d,	-- Construct.+		\MkColourScheme {+			getDarkPieceColour	= darkPieceColour,+			getLightPieceColour	= lightPieceColour,+			getDarkSquareColour	= darkSquareColour,+			getLightSquareColour	= lightSquareColour+		} -> (+			darkPieceColour,+			lightPieceColour,+			darkSquareColour,+			lightSquareColour+		) -- Deconstruct.+	 ) $ HXT.xp4Tuple (+		getDarkPieceColour def `HXT.xpDefault` HXT.xpAttr darkPieceColourTag HXT.xpickle+	 ) (+		getLightPieceColour def `HXT.xpDefault` HXT.xpAttr lightPieceColourTag HXT.xpickle+	 ) (+		getDarkSquareColour def `HXT.xpDefault` HXT.xpAttr darkSquareColourTag HXT.xpickle+	 ) (+		getLightSquareColour def `HXT.xpDefault` HXT.xpAttr lightSquareColourTag HXT.xpickle+	 ) where+		def :: ColourScheme+		def	= Data.Default.def++-- | Smart constructor.+mkColourScheme+	:: Colour.PhysicalColour.PhysicalColour	-- ^ Dark piece.+	-> Colour.PhysicalColour.PhysicalColour	-- ^ Light piece.+	-> Colour.PhysicalColour.PhysicalColour	-- ^ Dark square.+	-> Colour.PhysicalColour.PhysicalColour	-- ^ Light square.+	-> ColourScheme+mkColourScheme darkPieceColour lightPieceColour darkSquareColour lightSquareColour+	| darkPieceColour `elem` bgColours		= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Colour.ColourScheme.mkColourScheme:\t" . showString darkPieceColourTag . Text.ShowList.showsAssociation . shows darkPieceColour . showString " must differ from the physical colour of both squares; " $ shows bgColours "."+	| lightPieceColour `elem` bgColours		= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Colour.ColourScheme.mkColourScheme:\t" . showString lightPieceColourTag . Text.ShowList.showsAssociation . shows lightPieceColour . showString " must differ from the physical colour of both squares; " $ shows bgColours "."+	| darkSquareColour == lightSquareColour		= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Colour.ColourScheme.mkColourScheme:\tthe physical colours of " . shows lightSquareColourTag . showString " & " $ shows darkSquareColourTag ", must differ."+	| otherwise					= MkColourScheme {+		getDarkPieceColour	= darkPieceColour,+		getLightPieceColour	= lightPieceColour,+		getDarkSquareColour	= darkSquareColour,+		getLightSquareColour	= lightSquareColour+	}+	where+		bgColours	= [darkSquareColour, lightSquareColour]+

@@ -0,0 +1,151 @@+{-# LANGUAGE CPP, LambdaCase #-}+{-+	Copyright (C) 2018 Dr. Alistair Ward++	This file is part of BishBosh.++	BishBosh is free software: you can redistribute it and/or modify+	it under the terms of the GNU General Public License as published by+	the Free Software Foundation, either version 3 of the License, or+	(at your option) any later version.++	BishBosh is distributed in the hope that it will be useful,+	but WITHOUT ANY WARRANTY; without even the implied warranty of+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+	GNU General Public License for more details.++	You should have received a copy of the GNU General Public License+	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@]	Dr. Alistair Ward++ [@DESCRIPTION@]++	* Defines the data-type which represents the logical (rather than physical) colour of /piece/s & (conceptually) of the two players.++	* N.B.: conceptually different from the logical colour of squares on the board.+-}++module BishBosh.Colour.LogicalColour(+-- * Types+-- ** Type-synonyms+	ArrayByLogicalColour,+#ifdef USE_UNBOXED_ARRAYS+	UArrayByLogicalColour,+#endif+-- ** Data-types+	LogicalColour(..),+-- * Constants+	tag,+	range,+	nDistinctLogicalColours,+-- * Functions+-- ** Constructor+	listArrayByLogicalColour,+	arrayByLogicalColour,+-- ** Predicates+	isBlack+--	isWhite+) where++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	Control.DeepSeq+import qualified	Control.Exception+import qualified	Data.Array.IArray+import qualified	Data.List.Extra+import qualified	Text.XML.HXT.Arrow.Pickle			as HXT+import qualified	Text.XML.HXT.Arrow.Pickle.Schema++#ifdef USE_UNBOXED_ARRAYS+import qualified	Data.Array.Unboxed+#endif++-- | Used to qualify XML.+tag :: String+tag	= "logicalColour"++-- | The sum-type of /logical colour/s associated with either a piece, or (conceptually) a player.+data LogicalColour+	= Black+	| White+	deriving (+		Bounded,+		Enum,+		Eq,+		Ord,+		Read,+		Show+	)++instance Control.DeepSeq.NFData LogicalColour where+	rnf _	= ()++instance Data.Array.IArray.Ix LogicalColour where+	range (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) range+	inRange (lower, upper) logicalColour	= Control.Exception.assert (logicalColour >= lower && logicalColour <= upper) True+	index (lower, upper)			= Control.Exception.assert (lower == minBound && upper == maxBound) . fromEnum++-- | The constant ascending range of /logical colour/s.+range :: [LogicalColour]+range	= [minBound, maxBound]++instance Property.FixedMembership.FixedMembership LogicalColour where+	members	= range++-- | The constant number of distinct /logical colour/s.+nDistinctLogicalColours :: Type.Count.NLogicalColours+nDistinctLogicalColours	= fromIntegral $ length range++instance HXT.XmlPickler LogicalColour where+	xpickle	= HXT.xpAttr tag . HXT.xpWrap (read, show) . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range++instance Property.Opposable.Opposable LogicalColour where+	getOpposite Black	= White+	getOpposite _		= Black++instance Property.ExtendedPositionDescription.ReadsEPD LogicalColour where+	readsEPD s	= case Data.List.Extra.trimStart s of+		'b' : remainder	-> [(Black, remainder)]+		'w' : remainder	-> [(White, remainder)]+		_		-> []++instance Property.ExtendedPositionDescription.ShowsEPD LogicalColour where+	showsEPD	= showChar . \case+		Black	-> 'b'+		White	-> 'w'++instance Property.ForsythEdwards.ReadsFEN LogicalColour++instance Property.ForsythEdwards.ShowsFEN LogicalColour++-- | Whether the specified /logical colour/ is @Black@.+isBlack :: LogicalColour -> Bool+{-# INLINE isBlack #-}+isBlack Black	= True+isBlack _	= False++-- | Whether the specified /logical colour/ is @White@.+isWhite :: LogicalColour -> Bool+isWhite	= not . isBlack++-- | A boxed array indexed by /logical colour/, of arbitrary elements.+type ArrayByLogicalColour	= Data.Array.IArray.Array LogicalColour++#ifdef USE_UNBOXED_ARRAYS+-- | An unboxed array indexed by /logical colour/, of fixed-size values.+type UArrayByLogicalColour	= Data.Array.Unboxed.UArray LogicalColour+#endif++-- | Array-constructor from an ordered list of elements.+listArrayByLogicalColour :: Data.Array.IArray.IArray a e => [e] -> a LogicalColour e+listArrayByLogicalColour	= Data.Array.IArray.listArray (minBound, maxBound)++-- | Array-constructor from an association-list.+arrayByLogicalColour :: Data.Array.IArray.IArray a e => [(LogicalColour, e)] -> a LogicalColour e+arrayByLogicalColour	= Data.Array.IArray.array (minBound, maxBound)+

@@ -0,0 +1,59 @@+{-+	Copyright (C) 2018 Dr. Alistair Ward++	This file is part of BishBosh.++	BishBosh is free software: you can redistribute it and/or modify+	it under the terms of the GNU General Public License as published by+	the Free Software Foundation, either version 3 of the License, or+	(at your option) any later version.++	BishBosh is distributed in the hope that it will be useful,+	but WITHOUT ANY WARRANTY; without even the implied warranty of+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+	GNU General Public License for more details.++	You should have received a copy of the GNU General Public License+	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@]	Dr. Alistair Ward++ [@DESCRIPTION@]++	* Defines the data-type which represents the logical (rather than physical) colour of the squares on a chess-board.++	* N.B.: conceptually different from the logical colour of pieces.+-}++module BishBosh.Colour.LogicalColourOfSquare(+-- * Types+-- ** Data-type+	LogicalColourOfSquare(),+-- * Constants+	black,+	white,+-- * Functions+-- ** Predicate+	isBlack+) where++import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour++-- | The logical colour of a square of the board, cf. of a piece or (conceptually) of a player.+newtype LogicalColourOfSquare	= MkLogicalColourOfSquare {+	deconstruct	:: Colour.LogicalColour.LogicalColour+} deriving (Eq, Bounded)++-- | Constant.+black :: LogicalColourOfSquare+black	= MkLogicalColourOfSquare Colour.LogicalColour.Black++-- | Constant.+white :: LogicalColourOfSquare+white	= MkLogicalColourOfSquare Colour.LogicalColour.White++-- | Whether the specified /logical colour/ is @Black@.+isBlack :: LogicalColourOfSquare -> Bool+isBlack MkLogicalColourOfSquare { deconstruct = logicalColour }	= Colour.LogicalColour.isBlack logicalColour+

@@ -0,0 +1,119 @@+{-+	Copyright (C) 2018 Dr. Alistair Ward++	This file is part of BishBosh.++	BishBosh is free software: you can redistribute it and/or modify+	it under the terms of the GNU General Public License as published by+	the Free Software Foundation, either version 3 of the License, or+	(at your option) any later version.++	BishBosh is distributed in the hope that it will be useful,+	but WITHOUT ANY WARRANTY; without even the implied warranty of+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+	GNU General Public License for more details.++	You should have received a copy of the GNU General Public License+	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.+-}+{- |+ [@AUTHOR@]	Dr. Alistair Ward++ [@DESCRIPTION@]++	* Defines the data-type which represents the physical (rather than logical) colour of the /board/ & of /piece/s.++	* The number of physical colours used to represent the /board/ & /piece/s can be greater than the two /logical colour/s required,+	but is limited in practice, since the terminal (optionally) used to render the image, typically can't cope with with a large number.+-}++module BishBosh.Colour.PhysicalColour(+-- * Types+-- ** Data-types+	PhysicalColour(),+-- * Constants+--	range,+	black,+	red,+	green,+	yellow,+	blue,+	magenta,+	cyan,+	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.++	* CAVEAT: the constructor-order both facilitates conversion to an ANSI Colour-code & the derivation of the complementary colour.+-}+data PhysicalColour+	= Black+	| Red+	| Green+	| Yellow+	| Blue+	| Magenta+	| Cyan+	| White+	deriving (Enum, Eq, Read, Show)++instance Control.DeepSeq.NFData PhysicalColour where+	rnf _	= ()++instance Bounded PhysicalColour where+	minBound	= black+	maxBound	= white++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]++instance Property.FixedMembership.FixedMembership PhysicalColour where+	members	= range++-- | Constant.+black :: PhysicalColour+black	= Black++-- | Constant.+red :: PhysicalColour+red	= Red++-- | Constant.+green :: PhysicalColour+green	= Green++-- | Constant.+yellow :: PhysicalColour+yellow	= Yellow++-- | Constant.+blue :: PhysicalColour+blue	= Blue++-- | Constant.+magenta :: PhysicalColour+magenta	= Magenta++-- | Constant.+cyan :: PhysicalColour+cyan	= Cyan++-- | Constant.+white :: PhysicalColour+white	= White+

@@ -23,20 +23,20 @@ -}  module BishBosh.Component.Accountant(--- * Type-classes+-- * Type-class 	Accountant(..) ) where  import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank import qualified	BishBosh.Type.Count					as Type.Count+import qualified	BishBosh.Type.Mass					as Type.Mass  -- | 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.+		:: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank 		-> accountant-		-> [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.+		-> [Type.Mass.Base]	-- CAVEAT: can't return '[Type.Mass.PieceSquareValue]' because it's bounded. 

@@ -43,9 +43,9 @@  import			Control.Arrow((&&&)) import			Data.Array.IArray((!))-import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates+import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour import qualified	BishBosh.Component.Move			as Component.Move import qualified	BishBosh.Data.Exception			as Data.Exception import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership@@ -64,7 +64,7 @@ kingsMoveLength	= 2  -- | Define all possible castling-moves for the specified /logical colour/.-defineCastlingMoves :: Attribute.LogicalColour.LogicalColour -> [CastlingMove]+defineCastlingMoves :: Colour.LogicalColour.LogicalColour -> [CastlingMove] defineCastlingMoves logicalColour	= [ 	MkCastlingMove { 		getMoveType	= Attribute.MoveType.longCastle,@@ -81,24 +81,24 @@ 	}  ] where 	isBlack :: Bool-	isBlack	= Attribute.LogicalColour.isBlack logicalColour+	isBlack	= Colour.LogicalColour.isBlack logicalColour  	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 :: Attribute.LogicalColour.ArrayByLogicalColour [CastlingMove]-castlingMovesByLogicalColour	= Attribute.LogicalColour.listArrayByLogicalColour $ map defineCastlingMoves Property.FixedMembership.members+castlingMovesByLogicalColour :: Colour.LogicalColour.ArrayByLogicalColour [CastlingMove]+castlingMovesByLogicalColour	= Colour.LogicalColour.listArrayByLogicalColour $ map defineCastlingMoves Property.FixedMembership.members  {- | 	* Accessor.  	* CAVEAT: the moves are returned in unspecified order. -}-getCastlingMoves :: Attribute.LogicalColour.LogicalColour -> [CastlingMove]+getCastlingMoves :: Colour.LogicalColour.LogicalColour -> [CastlingMove] getCastlingMoves	= (castlingMovesByLogicalColour !)  -- | Break-down the two castling-moves for the specified /logical colour/ into a long & a short castling-move.-getLongAndShortMoves :: Attribute.LogicalColour.LogicalColour -> (CastlingMove, CastlingMove)+getLongAndShortMoves :: Colour.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."

@@ -46,13 +46,14 @@ 	isPawnDoubleAdvance ) where -import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour-import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates-import qualified	BishBosh.Cartesian.Vector		as Cartesian.Vector-import qualified	BishBosh.Property.Opposable		as Property.Opposable-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			Control.Arrow((&&&))+import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates+import qualified	BishBosh.Cartesian.Vector	as Cartesian.Vector+import qualified	BishBosh.Colour.LogicalColour	as Colour.LogicalColour+import qualified	BishBosh.Property.Opposable	as Property.Opposable+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	Control.Arrow import qualified	Control.DeepSeq import qualified	Control.Exception@@ -77,8 +78,8 @@ } deriving Eq  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'+	l'@MkMove { getSource = l } `compare` r'@MkMove { getSource = r }	= case l `compare` r of+		EQ		-> Data.Ord.comparing getDestination l' r' 		ordering	-> ordering  instance Control.DeepSeq.NFData Move where@@ -106,8 +107,17 @@ 	}  instance Property.Orientated.Orientated Move where+	isVertical MkMove {+		getSource	= source,+		getDestination	= destination+	} = Cartesian.Coordinates.getX source == Cartesian.Coordinates.getX destination++	isHorizontal MkMove {+		getSource	= source,+		getDestination	= destination+	} = Cartesian.Coordinates.getY source == Cartesian.Coordinates.getY destination+ 	isDiagonal	= Property.Orientated.isDiagonal . measureDistance-	isParallel	= Property.Orientated.isParallel . measureDistance  instance Property.Reflectable.ReflectableOnX Move where 	reflectOnX MkMove {@@ -159,10 +169,12 @@ 	but passing only guarantees that it is, if it was a @Pawn@ which moved & that the /move/ is valid. -} isPawnDoubleAdvance-	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side whose move is referenced.-	-> Move+	:: Move+	-> Colour.LogicalColour.LogicalColour	-- ^ Defines the side whose move is referenced. 	-> Bool-isPawnDoubleAdvance logicalColour move@MkMove { getSource = source }	= Cartesian.Coordinates.isPawnsFirstRank logicalColour source && Cartesian.Vector.matchesPawnDoubleAdvance logicalColour (-	measureDistance move+isPawnDoubleAdvance move@MkMove { getSource = source }	= uncurry (&&) . (+	Cartesian.Coordinates.isPawnsFirstRank source &&& Cartesian.Vector.matchesPawnDoubleAdvance (+		measureDistance move+	)  ) 

@@ -72,24 +72,25 @@ 	isKnight, --	isBishop, --	isRook,---	isQueen,+	isQueen, 	isKing, 	isPawnPromotion ) where  import			Control.Arrow((&&&), (***)) import			Data.Array.IArray((!))-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.Coordinates			as Cartesian.Coordinates import qualified	BishBosh.Cartesian.Ordinate			as Cartesian.Ordinate import qualified	BishBosh.Cartesian.Vector			as Cartesian.Vector+import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour import qualified	BishBosh.Data.Exception				as Data.Exception+import qualified	BishBosh.Direction.Direction			as Direction.Direction 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.Property.Orientated			as Property.Orientated import qualified	BishBosh.Type.Count				as Type.Count import qualified	Control.DeepSeq import qualified	Control.Exception@@ -116,7 +117,7 @@  -- | A Chess-piece has a /logical colour/ & a /rank/. data Piece	= MkPiece {-	getLogicalColour	:: Attribute.LogicalColour.LogicalColour,+	getLogicalColour	:: Colour.LogicalColour.LogicalColour, 	getRank			:: Attribute.Rank.Rank } deriving (Bounded, Eq, Ord) @@ -149,8 +150,8 @@ 		c : remainder	-> ( 			MkPiece ( 				if Data.Char.isUpper c-					then Attribute.LogicalColour.White-					else Attribute.LogicalColour.Black+					then Colour.LogicalColour.White+					else Colour.LogicalColour.Black 			) *** const remainder 		 ) `map` reads [c] 		_		-> []	-- No parse.@@ -195,31 +196,31 @@ 	members	= range  -- | Constructor.-mkPiece :: Attribute.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> Piece+mkPiece :: Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> Piece mkPiece	= MkPiece  -- | Constructor.-mkPawn :: Attribute.LogicalColour.LogicalColour -> Piece+mkPawn :: Colour.LogicalColour.LogicalColour -> Piece mkPawn	= (`MkPiece` Attribute.Rank.Pawn)  -- | Constructor.-mkRook :: Attribute.LogicalColour.LogicalColour -> Piece+mkRook :: Colour.LogicalColour.LogicalColour -> Piece mkRook	= (`MkPiece` Attribute.Rank.Rook)  -- | Constructor.-mkKnight :: Attribute.LogicalColour.LogicalColour -> Piece+mkKnight :: Colour.LogicalColour.LogicalColour -> Piece mkKnight	= (`MkPiece` Attribute.Rank.Knight)  -- | Constructor.-mkBishop:: Attribute.LogicalColour.LogicalColour -> Piece+mkBishop:: Colour.LogicalColour.LogicalColour -> Piece mkBishop	= (`MkPiece` Attribute.Rank.Bishop)  -- | Constructor.-mkQueen :: Attribute.LogicalColour.LogicalColour -> Piece+mkQueen :: Colour.LogicalColour.LogicalColour -> Piece mkQueen	= (`MkPiece` Attribute.Rank.Queen)  -- | Constructor.-mkKing :: Attribute.LogicalColour.LogicalColour -> Piece+mkKing :: Colour.LogicalColour.LogicalColour -> Piece mkKing	= (`MkPiece` Attribute.Rank.King)  -- | Changes the specified /piece/ to the specified /rank/ leaving its /logical colour/ unchanged.@@ -230,15 +231,15 @@ 	| otherwise						= piece { getRank = newRank }  -- | The structure of a container of arbitrary data, indexed by /logicalColour/ & some /rank/s.-type ByRankByLogicalColour element	= Attribute.LogicalColour.ArrayByLogicalColour (Map.Map Attribute.Rank.Rank element)+type ByRankByLogicalColour element	= Colour.LogicalColour.ArrayByLogicalColour (Map.Map Attribute.Rank.Rank element)  -- | Constructor of a certain shape of container, but with arbitrary contents. mkByRankByLogicalColour :: #ifdef USE_PARALLEL 	Control.DeepSeq.NFData	element => #endif-	[Attribute.Rank.Rank] -> (Attribute.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element) -> ByRankByLogicalColour element-mkByRankByLogicalColour ranks mkElement	= Attribute.LogicalColour.listArrayByLogicalColour+	[Attribute.Rank.Rank] -> (Colour.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element) -> ByRankByLogicalColour element+mkByRankByLogicalColour ranks mkElement	= Colour.LogicalColour.listArrayByLogicalColour #ifdef USE_PARALLEL 	. Control.Parallel.Strategies.withStrategy (Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq) #endif@@ -265,14 +266,14 @@  -- | 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+	:: Piece+	-> Cartesian.Coordinates.Coordinates	-- ^ The source from which the attack originates. 	-> [Cartesian.Coordinates.Coordinates]	-- ^ The destinations which can be attacked.-findAttackDestinations' source MkPiece {+findAttackDestinations' MkPiece { 	getLogicalColour	= logicalColour, 	getRank			= rank-} = Data.Maybe.mapMaybe (-	Cartesian.Vector.maybeTranslate source+} source	= Data.Maybe.mapMaybe (+	`Cartesian.Vector.maybeTranslate` source  ) ( 	attackVectorsByRankByLogicalColour ! logicalColour Map.! rank  )@@ -286,40 +287,40 @@ -} attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour attackDestinationsByCoordinatesByRankByLogicalColour	= mkByRankByLogicalColour Attribute.Rank.fixedAttackRange $ \logicalColour rank -> Cartesian.Coordinates.listArrayByCoordinates $ map (-	`findAttackDestinations'` mkPiece logicalColour rank+	findAttackDestinations' $! mkPiece logicalColour rank  ) Property.FixedMembership.members  -- | 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+	:: Piece+	-> Cartesian.Coordinates.Coordinates	-- ^ The source from which the attack originates. 	-> [Cartesian.Coordinates.Coordinates]	-- ^ The destinations which can be attacked.-findAttackDestinations coordinates MkPiece {+findAttackDestinations MkPiece { 	getLogicalColour	= logicalColour, 	getRank			= rank-} = attackDestinationsByCoordinatesByRankByLogicalColour ! logicalColour Map.! rank ! coordinates+} coordinates	= attackDestinationsByCoordinatesByRankByLogicalColour ! logicalColour Map.! rank ! coordinates  -- The constant /direction/s of the straight lines along which each type of /piece/ can attack.   {- |-	* Find the constant /direction/s of the straight lines along which each type of /piece/ can attack.+	* The constant /direction/s of the straight lines along which each type of /piece/ can attack.  	* CAVEAT: not defined for a @Knight@. -}-attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Attribute.Direction.Direction]+attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Direction.Direction.Direction] attackDirectionsByRankByLogicalColour	= mkByRankByLogicalColour Attribute.Rank.earthBound $ \logicalColour -> \case-	Attribute.Rank.Pawn	-> Attribute.Direction.attackDirectionsForPawn logicalColour-	Attribute.Rank.Bishop	-> Attribute.Direction.diagonals-	Attribute.Rank.Rook	-> Attribute.Direction.parallels-	_ {-royalty-}		-> Property.FixedMembership.members+	Attribute.Rank.Pawn	-> Direction.Direction.attackDirectionsForPawn logicalColour+	Attribute.Rank.Bishop	-> Direction.Direction.diagonals+	Attribute.Rank.Rook	-> Direction.Direction.parallels+	_ {-royalty-}		-> Property.FixedMembership.members {-directions-}  {- | 	* Get the constant /direction/s of the straight lines along which the specified /piece/ can attack.  	* CAVEAT: not defined for a @Knight@. -}-getAttackDirections :: Piece -> [Attribute.Direction.Direction]+getAttackDirections :: Piece -> [Direction.Direction.Direction] getAttackDirections MkPiece { 	getLogicalColour	= logicalColour, 	getRank			= rank@@ -341,15 +342,13 @@ 	-> Bool canAttackAlong source destination piece	= ( 	case getRank piece of-		Attribute.Rank.Pawn	-> Cartesian.Vector.isPawnAttack $ getLogicalColour piece+		Attribute.Rank.Pawn	-> (`Cartesian.Vector.isPawnAttack` getLogicalColour piece) 		Attribute.Rank.Knight	-> Cartesian.Vector.isKnightsMove-		Attribute.Rank.Bishop	-> Cartesian.Vector.isDiagonal-		Attribute.Rank.Rook	-> Cartesian.Vector.isParallel-		Attribute.Rank.Queen	-> Cartesian.Vector.isStraight+		Attribute.Rank.Bishop	-> Property.Orientated.isDiagonal+		Attribute.Rank.Rook	-> Property.Orientated.isParallel+		Attribute.Rank.Queen	-> Property.Orientated.isStraight 		Attribute.Rank.King	-> Cartesian.Vector.isKingsMove- ) (-	Cartesian.Vector.measureDistance source destination- )+ ) $! Cartesian.Vector.measureDistance source destination  {- | 	* Whether the specified /piece/ can move between the specified /coordinates/.@@ -357,47 +356,52 @@ 	* N.B.: can't detect any blocking pieces. -} canMoveBetween-	:: Cartesian.Coordinates.Coordinates	-- ^ Source.+	:: Piece+	-> Cartesian.Coordinates.Coordinates	-- ^ Source. 	-> Cartesian.Coordinates.Coordinates	-- ^ Destination.-	-> Piece 	-> Bool-canMoveBetween source destination piece	= (+canMoveBetween piece source destination	= ( 	case getRank piece of-		Attribute.Rank.Pawn	-> \distance -> let+		Attribute.Rank.Pawn	-> let 			logicalColour	= getLogicalColour piece-		 in Cartesian.Vector.isPawnAttack logicalColour distance || Cartesian.Vector.getXDistance distance == 0 && (-			let-				y'	= (-					if Attribute.LogicalColour.isBlack logicalColour-						then negate-						else id-				 ) $ Cartesian.Vector.getYDistance distance-			in y' == 1 || Cartesian.Coordinates.isPawnsFirstRank logicalColour source && y' == 2+		 in uncurry (||) . (+			(`Cartesian.Vector.isPawnAttack` logicalColour) &&& (+				uncurry (&&) . (+					(== 0) . Cartesian.Vector.getXDistance &&& (+						\case+							1	-> True+							2	-> Cartesian.Coordinates.isPawnsFirstRank source logicalColour+							_	-> False+					) . (+						if Colour.LogicalColour.isBlack logicalColour+							then negate+							else id+					) . Cartesian.Vector.getYDistance+				)+			) 		 ) 		Attribute.Rank.Knight	-> Cartesian.Vector.isKnightsMove-		Attribute.Rank.Bishop	-> Cartesian.Vector.isDiagonal-		Attribute.Rank.Rook	-> Cartesian.Vector.isParallel-		Attribute.Rank.Queen	-> Cartesian.Vector.isStraight+		Attribute.Rank.Bishop	-> Property.Orientated.isDiagonal+		Attribute.Rank.Rook	-> Property.Orientated.isParallel+		Attribute.Rank.Queen	-> Property.Orientated.isStraight 		Attribute.Rank.King	-> Cartesian.Vector.isKingsMove- ) (-	Cartesian.Vector.measureDistance source destination- )+ ) $! Cartesian.Vector.measureDistance source destination  -- | Whether a move qualifies for @Pawn@-promotion. isPawnPromotion-	:: Cartesian.Coordinates.Coordinates	-- ^ Destination.-	-> Piece+	:: Piece+	-> Cartesian.Coordinates.Coordinates	-- ^ Destination. 	-> Bool-isPawnPromotion destination MkPiece {+isPawnPromotion MkPiece { 	getLogicalColour	= logicalColour, 	getRank			= Attribute.Rank.Pawn-}			= Cartesian.Ordinate.lastRank logicalColour == Cartesian.Coordinates.getY destination+} destination		= Cartesian.Ordinate.lastRank logicalColour == Cartesian.Coordinates.getY destination isPawnPromotion _ _	= False  -- | Whether the specified /piece/ is @Black@. {-# INLINE isBlack #-} isBlack :: Piece -> Bool-isBlack MkPiece { getLogicalColour = Attribute.LogicalColour.Black }	= True+isBlack MkPiece { getLogicalColour = Colour.LogicalColour.Black }	= True isBlack _								= False  -- | Whether the specified /piece/s have the same /logical colour/.

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -45,76 +46,97 @@  import			Control.Arrow((&&&), (|||)) import			Data.Array.IArray((!))-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.Colour.LogicalColour		as Colour.LogicalColour import qualified	BishBosh.Component.Piece		as Component.Piece import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership 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.Mass			as Type.Mass import qualified	Control.DeepSeq import qualified	Data.Array.IArray import qualified	Data.Foldable import qualified	Data.List +#if defined(USE_UNBOXED_ARRAYS) && !(defined(USE_NEWTYPE_WRAPPERS) || defined(USE_PRECISION))+#define UNBOX+import qualified	Data.Array.Unboxed+#endif+ -- | The piece-square value may vary as the game progresses.-type PieceSquareValueByNPieces pieceSquareValue	= Data.Array.IArray.Array Type.Count.NPieces pieceSquareValue+type PieceSquareValueByNPieces =+#ifdef UNBOX+	Data.Array.Unboxed.UArray+#else+	Data.Array.IArray.Array+#endif+		Type.Count.NPieces Type.Mass.PieceSquareValue  -- | The bounds of the number of pieces on the board, at the end-game & opening-game respectively. nPiecesBounds :: (Type.Count.NPieces, Type.Count.NPieces) nPiecesBounds	= ( 	3 {-minimum sufficient material-},-	fromIntegral Attribute.LogicalColour.nDistinctLogicalColours * Component.Piece.nPiecesPerSide+	fromIntegral Colour.LogicalColour.nDistinctLogicalColours * Component.Piece.nPiecesPerSide  )  -- | Self-documentation.-type EitherPieceSquareValueByNPiecesByCoordinates pieceSquareValue	= Either (-	Cartesian.Coordinates.ArrayByCoordinates pieceSquareValue	-- Uninterpolated.+type EitherPieceSquareValueByNPiecesByCoordinates	= Either (+#ifdef UNBOX+	Cartesian.Coordinates.UArrayByCoordinates+#else+	Cartesian.Coordinates.ArrayByCoordinates+#endif+		Type.Mass.PieceSquareValue	-- Uninterpolated.  ) (-	Cartesian.Coordinates.ArrayByCoordinates (PieceSquareValueByNPieces pieceSquareValue)	-- Interpolated.+	Cartesian.Coordinates.ArrayByCoordinates PieceSquareValueByNPieces	-- Interpolated.  )  -- | The value for each type of /piece/ of occupying each coordinate, at each stage in the lifetime of the game.-newtype PieceSquareByCoordinatesByRank pieceSquareValue	= MkPieceSquareByCoordinatesByRank {-	deconstruct	:: Attribute.Rank.ArrayByRank (EitherPieceSquareValueByNPiecesByCoordinates pieceSquareValue)+newtype PieceSquareByCoordinatesByRank	= MkPieceSquareByCoordinatesByRank {+	deconstruct	:: Attribute.Rank.ArrayByRank EitherPieceSquareValueByNPiecesByCoordinates } deriving (Eq, Show) -instance Control.DeepSeq.NFData pieceSquareValue => Control.DeepSeq.NFData (PieceSquareByCoordinatesByRank pieceSquareValue) where-	rnf MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= Control.DeepSeq.rnf byRank+instance Control.DeepSeq.NFData PieceSquareByCoordinatesByRank where+	rnf+#ifdef UNBOX+		_								= ()+#else+		MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= Control.DeepSeq.rnf byRank+#endif  -- | Constructor. mkPieceSquareByCoordinatesByRank-	:: (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+	:: (Attribute.Rank.Rank -> EitherPieceSquareValueByNPiecesByCoordinates)	-- ^ Convert a /rank/ into either (a /pieceSquareValue/ or a /pieceSquareValue/ which linearly varies with the number of /piece/s remaining) by /coordinates/.+	-> PieceSquareByCoordinatesByRank mkPieceSquareByCoordinatesByRank	= MkPieceSquareByCoordinatesByRank . Attribute.Rank.listArrayByRank . (`map` Property.FixedMembership.members)  -- | 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-	:: 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		-- ^ The /piece/'s location.-	-> pieceSquareValue+	:: PieceSquareByCoordinatesByRank+	-> Type.Count.NPieces			-- ^ The progress through the game.+	-> Colour.LogicalColour.LogicalColour	-- ^ The /piece/'s /logical colour/.+	-> Attribute.Rank.Rank			-- ^ The /piece/'s /rank/.+	-> Cartesian.Coordinates.Coordinates	-- ^ The /piece/'s location.+	-> Type.Mass.PieceSquareValue findPieceSquareValue MkPieceSquareByCoordinatesByRank { deconstruct = byRank } nPieces logicalColour rank	= ( 	(!) ||| ( 		\byNPiecesByCoordinates	-> (! nPieces) . (byNPiecesByCoordinates !) 	) $ byRank ! rank- ) . if Attribute.LogicalColour.isBlack logicalColour+ ) . if Colour.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-	:: Fractional pieceSquareValue-	=> pieceSquareValue	-- ^ Opening-game.-	-> pieceSquareValue	-- ^ End-game.-	-> PieceSquareValueByNPieces pieceSquareValue+	:: Type.Mass.PieceSquareValue	-- ^ Opening-game.+	-> Type.Mass.PieceSquareValue	-- ^ End-game.+	-> PieceSquareValueByNPieces interpolatePieceSquareValues openingGame endGame	= Data.Array.IArray.listArray nPiecesBounds . map (-	uncurry (+) . (-		(* openingGame) &&& (* endGame) . (1 -)+	fromRational . uncurry (+) . (+		(* toRational openingGame) &&& (* toRational endGame) . (1 -) 	) . ( 		/ fromIntegral ( 			uncurry subtract nPiecesBounds	-- N.B.: this can't reasonably be zero.@@ -130,12 +152,12 @@  -- | Format the data for input to __GNUPlot__. formatForGNUPlot-	:: (pieceSquareValue -> ShowS)						-- ^ Format a /pieceSquareValue/.-	-> ShowS								-- ^ The column-delimiter.-	-> (PieceSquareValueByNPieces pieceSquareValue -> pieceSquareValue)	-- ^ Select one /pieceSquareValue/ from interpolated values.-	-> PieceSquareByCoordinatesByRank pieceSquareValue+	:: PieceSquareByCoordinatesByRank+	-> (Type.Mass.PieceSquareValue -> ShowS)			-- ^ Format a /pieceSquareValue/.+	-> ShowS							-- ^ The column-delimiter.+	-> (PieceSquareValueByNPieces -> Type.Mass.PieceSquareValue)	-- ^ Select one /PieceSquareValue/ from interpolated values. 	-> ShowS-formatForGNUPlot pieceSquareValueFormatter columnDelimiter selector MkPieceSquareByCoordinatesByRank { deconstruct = byRank }	= (+formatForGNUPlot MkPieceSquareByCoordinatesByRank { deconstruct = byRank } pieceSquareValueFormatter columnDelimiter selector	= ( 	showsRow ( 		showChar gnuPlotComment . showChar 'x' : showChar 'y' : map shows Attribute.Rank.range	-- Header comment. 	) .@@ -152,7 +174,7 @@  ) id . zip ( 	Property.FixedMembership.members	:: [Cartesian.Coordinates.Coordinates]  ) . Data.List.transpose . map (-	Data.Foldable.toList ||| map selector {-select one pieceSquareValue from interpolated values-} . Data.Foldable.toList {-ByCoordinates-}+	Data.Array.IArray.elems ||| 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

@@ -24,6 +24,8 @@  module BishBosh.Component.QualifiedMove( -- * Types+-- * Type-synonyms+	QualifiedMoveSequence, -- ** Data-types 	QualifiedMove( --		MkQualifiedMove,@@ -68,4 +70,7 @@ -- | Constructor. mkQualifiedMove	:: Component.Move.Move -> Attribute.MoveType.MoveType -> QualifiedMove mkQualifiedMove	= MkQualifiedMove++-- | A sequence of QualifiedMoves applied to a game.+type QualifiedMoveSequence	= [QualifiedMove] 

@@ -42,9 +42,9 @@ ) where  import			Control.Arrow((&&&))-import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType import qualified	BishBosh.Attribute.Rank			as Attribute.Rank+import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour import qualified	BishBosh.Component.Move			as Component.Move import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove import qualified	BishBosh.Property.Reflectable		as Property.Reflectable@@ -116,13 +116,13 @@  -- | Whether the /turn/ represents a @Pawn@'s initial two-square advance. isPawnDoubleAdvance-	:: Attribute.LogicalColour.LogicalColour	-- ^ Defines the side whose /turn/ is referenced.-	-> Turn+	:: Turn+	-> Colour.LogicalColour.LogicalColour	-- ^ Defines the side whose /turn/ is referenced. 	-> Bool-isPawnDoubleAdvance logicalColour MkTurn {+isPawnDoubleAdvance MkTurn { 	getRank			= Attribute.Rank.Pawn, 	getQualifiedMove	= qualifiedMove-} = Component.Move.isPawnDoubleAdvance logicalColour (Component.QualifiedMove.getMove qualifiedMove) && Component.QualifiedMove.getMoveType qualifiedMove == Data.Default.def+} logicalColour		= Component.Move.isPawnDoubleAdvance (Component.QualifiedMove.getMove qualifiedMove) logicalColour && Component.QualifiedMove.getMoveType qualifiedMove == Data.Default.def isPawnDoubleAdvance _ _	= False  -- | Forwards the request to 'Attribute.Rank.compareByLVA'.

@@ -51,12 +51,12 @@  import			Control.Arrow((***)) import			Data.Array.IArray((!))-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.Data.Exception			as Data.Exception-import qualified	BishBosh.Type.Length			as Type.Length+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.Colour.LogicalColour	as Colour.LogicalColour+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@@ -66,15 +66,15 @@ import qualified	ToolShed.System.Random  -- | Used as an index into 'getRandomByCoordinatesByRankByLogicalColour'.-type Index	= (Attribute.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates)+type Index	= (Colour.LogicalColour.LogicalColour, Attribute.Rank.Rank, Cartesian.Coordinates.Coordinates)  -- | The random numbers used to generate a hash, which almost uniquely represent a /position/. 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'.+	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 [(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.+	getRandomByCastleableRooksXByLogicalColour	:: Colour.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 where@@ -133,7 +133,7 @@ 			) . System.Random.split 		 ) *** ( 			(-				Attribute.LogicalColour.listArrayByLogicalColour . map (+				Colour.LogicalColour.listArrayByLogicalColour . map ( 					zip [Cartesian.Abscissa.xMin, Cartesian.Abscissa.xMax] . System.Random.randoms 				) . ToolShed.System.Random.randomGens *** Cartesian.Abscissa.listArrayByAbscissa . System.Random.randoms 			) . System.Random.split@@ -147,18 +147,18 @@ 		}  -- | Dereferences 'getRandomByCoordinatesByRankByLogicalColour' using the specified index.-dereferenceRandomByCoordinatesByRankByLogicalColour :: Index -> Zobrist positionHash -> positionHash-dereferenceRandomByCoordinatesByRankByLogicalColour index MkZobrist { getRandomByCoordinatesByRankByLogicalColour = randomByCoordinatesByRankByLogicalColour }	= randomByCoordinatesByRankByLogicalColour ! index+dereferenceRandomByCoordinatesByRankByLogicalColour :: Zobrist positionHash -> Index -> positionHash+dereferenceRandomByCoordinatesByRankByLogicalColour MkZobrist { getRandomByCoordinatesByRankByLogicalColour = randomByCoordinatesByRankByLogicalColour }	= (randomByCoordinatesByRankByLogicalColour !)  -- | Dereferences 'getRandomByCastleableRooksXByLogicalColour' using the specified abscissa. dereferenceRandomByCastleableRooksXByLogicalColour-	:: Attribute.LogicalColour.LogicalColour+	:: Zobrist positionHash+	-> Colour.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+dereferenceRandomByCastleableRooksXByLogicalColour MkZobrist { getRandomByCastleableRooksXByLogicalColour = randomByCastleableRooksXByLogicalColour } logicalColour x	= lookup x $ randomByCastleableRooksXByLogicalColour ! logicalColour  -- | Dereferences 'getRandomByEnPassantAbscissa' using the specified abscissa.-dereferenceRandomByEnPassantAbscissa :: Type.Length.X -> Zobrist positionHash -> positionHash-dereferenceRandomByEnPassantAbscissa x MkZobrist { getRandomByEnPassantAbscissa = randomByEnPassantAbscissa }	= randomByEnPassantAbscissa ! x+dereferenceRandomByEnPassantAbscissa :: Zobrist positionHash -> Type.Length.X -> positionHash+dereferenceRandomByEnPassantAbscissa MkZobrist { getRandomByEnPassantAbscissa = randomByEnPassantAbscissa }	= (randomByEnPassantAbscissa !) 

@@ -72,7 +72,7 @@  ) where  import			Control.Arrow((&&&), (***))-import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour+import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour import qualified	BishBosh.ContextualNotation.PGNComment		as ContextualNotation.PGNComment import qualified	BishBosh.ContextualNotation.StandardAlgebraic	as ContextualNotation.StandardAlgebraic import qualified	BishBosh.Data.Exception				as Data.Exception@@ -475,7 +475,7 @@ 		expectedMoveNumber	= fromIntegral . succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game 	 in do 		moveNumber	<- (-			if Attribute.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game+			if Colour.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game 				then fmap (Data.Maybe.fromMaybe expectedMoveNumber) . Control.Applicative.optional 				else id 		 ) moveNumberParser@@ -514,7 +514,7 @@ 		expectedMoveNumber	= fromIntegral . succ . (`div` 2) . State.TurnsByLogicalColour.getNPlies $ Model.Game.getTurnsByLogicalColour game 	 in do 		moveNumber	<- (-			if Attribute.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game+			if Colour.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game 				then fmap (Data.Maybe.fromMaybe expectedMoveNumber) . Control.Applicative.optional 				else id 		 ) moveNumberParser

@@ -39,6 +39,7 @@ 	PositionHashQualifiedMoveTree(), -- * Functions --	onymiseQualifiedMove,+--	colourFlipper, --	findNextOnymousQualifiedMovesForGame, 	findNextOnymousQualifiedMovesForPosition, --	findNextJoiningOnymousQualifiedMovesFromPosition,@@ -53,8 +54,8 @@  ) where  import			Control.Arrow((&&&), (***))-import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType+import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour import qualified	BishBosh.Component.Piece			as Component.Piece import qualified	BishBosh.Component.QualifiedMove		as Component.QualifiedMove import qualified	BishBosh.Component.Turn				as Component.Turn@@ -77,6 +78,7 @@ import qualified	Data.List.Extra import qualified	Data.Maybe import qualified	Data.Tree+import qualified	Data.Tuple import qualified	System.Random import qualified	ToolShed.System.Random @@ -101,7 +103,7 @@ 	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.+-- | Constructor: augment the specified /qualified-move forest/ with a /Zobrist-hash/ of the /position/ & include the default initial game at the apex. fromQualifiedMoveForest 	:: Data.Bits.Bits positionHash 	=> Bool	-- ^ IncrementalEvaluation.@@ -122,7 +124,7 @@ 	) tree } where 	initialGame		= Data.Default.def-	initialPositionHash	= StateProperty.Hashable.hash initialGame zobrist+	initialPositionHash	= StateProperty.Hashable.hash zobrist initialGame 	tree			= Data.Tree.Node { 		Data.Tree.rootLabel	= MkNodeLabel initialPositionHash Nothing, 		Data.Tree.subForest	= map (@@ -143,7 +145,7 @@ 						Data.Tree.rootLabel	= label@(qualifiedMove, _), 						Data.Tree.subForest	= qualifiedMoveForest' 					} = Data.Tree.Node {-						Data.Tree.rootLabel	= MkNodeLabel (StateProperty.Hashable.hash game' zobrist) $ Just label,	-- Hash the game after applying the move.+						Data.Tree.rootLabel	= MkNodeLabel (StateProperty.Hashable.hash zobrist game') $ Just label,	-- Hash the game after applying the move. 						Data.Tree.subForest	= map (slave game') qualifiedMoveForest'	-- Recurse. 					} where 						game'	= Model.Game.applyQualifiedMove qualifiedMove game@@ -161,8 +163,8 @@  	* CAVEAT: a negative result doesn't imply that convergence is possible, since other factors may prevent it. -}-cantConverge :: Model.Game.Game -> PositionHashQualifiedMoveTree positionHash -> Bool-cantConverge game MkPositionHashQualifiedMoveTree { getMinimumPieces = minimumPieces }	= State.Board.getNPieces (Model.Game.getBoard game) < minimumPieces+cantConverge :: PositionHashQualifiedMoveTree positionHash -> Model.Game.Game -> Bool+cantConverge MkPositionHashQualifiedMoveTree { getMinimumPieces = minimumPieces }	= (< minimumPieces) . State.Board.getNPieces . Model.Game.getBoard  -- | A /qualified move/ annotated by the name & ultimate /result/, of each /game/ from which it could have originated. type OnymousQualifiedMove	= (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.OnymousResult])@@ -178,13 +180,14 @@  ) . Data.Tree.flatten  -- | The type of a function used to locate a match in the tree.-type FindMatch positionHash	= Model.Game.Game -> PositionHashQualifiedMoveTree positionHash -> [OnymousQualifiedMove]+type FindMatch positionHash	= PositionHashQualifiedMoveTree positionHash -> Model.Game.Game -> [OnymousQualifiedMove]  -- | For any exactly matching /game/ in the tree, return the subsequent /qualifiedMove/s. findNextOnymousQualifiedMovesForGame :: FindMatch positionHash-findNextOnymousQualifiedMovesForGame requiredGame	= slave (+findNextOnymousQualifiedMovesForGame MkPositionHashQualifiedMoveTree { getTree = tree } requiredGame	= slave ( 	Model.Game.listTurnsChronologically requiredGame- ) . Data.Tree.subForest {-remove the apex which lacks a founding move-} . getTree where+ ) $ Data.Tree.subForest {-remove the apex which lacks a founding move-} tree where+	slave :: [Component.Turn.Turn] -> [Tree positionHash] -> [OnymousQualifiedMove] 	slave (turn : remainingTurns)	= Data.Maybe.maybe [] {-match-failure-} ( 		slave remainingTurns . Data.Tree.subForest	-- Recurse. 	 ) . Data.List.find (@@ -204,43 +207,41 @@ 	* CAVEAT: a null list can result from either match-failure, or a match with the final /move/ of a /game/. -} 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+findNextOnymousQualifiedMovesForPosition positionHashQualifiedMoveTree requiredGame+	| cantConverge positionHashQualifiedMoveTree requiredGame	= []	-- The game we're required to match has fewer pieces than any defined in the tree.+	| otherwise							= slave (+		(+			uncurry (***) . (id &&& id) $ (Component.Piece.nPiecesPerSide -)	-- Find the number of pieces at the apex of the tree, in excess of the requiredGame, to be taken before a match can be found.+		) . StateProperty.Censor.countPiecesByLogicalColour . State.Board.getCoordinatesByRankByLogicalColour . Model.Game.getBoard $ requiredGame+	) $ getTree positionHashQualifiedMoveTree 	where-		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 (nPiecesDiffOpponent, nPiecesDiffMover) Data.Tree.Node {+		slave nPiecesDiff Data.Tree.Node { 			Data.Tree.rootLabel	= MkNodeLabel { getPositionHash = positionHash }, 			Data.Tree.subForest	= forest 		} = (-			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.+			case snd {-mover-} nPiecesDiff `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.+					| positionHash == StateProperty.Hashable.hash (+						getZobrist positionHashQualifiedMoveTree+					) requiredGame	-> (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, _) } 			} -> slave (-				nPiecesDiffMover,-				(+				Data.Tuple.swap $ ( 					if Attribute.MoveType.isCapture $! Component.QualifiedMove.getMoveType qualifiedMove-						then pred+						then Control.Arrow.first pred	-- Decrement opponent's piece-count. 						else id-				) nPiecesDiffOpponent-			) {-swap pair-} node	-- Recurse.+				) nPiecesDiff+			) node	-- Recurse. 		 ) forest  -- | Finds any single /move/s which can join the current /position/ with a member of the forest. findNextJoiningOnymousQualifiedMovesFromPosition :: Data.Bits.Bits positionHash => FindMatch positionHash-{-# SPECIALISE findNextJoiningOnymousQualifiedMovesFromPosition :: FindMatch Type.Crypto.PositionHash #-}-findNextJoiningOnymousQualifiedMovesFromPosition game positionHashQualifiedMoveTree+findNextJoiningOnymousQualifiedMovesFromPosition positionHashQualifiedMoveTree game 	| Model.Game.isTerminated game	= [] 	| otherwise			= [ 		Control.Arrow.second (concatMap snd {-[OnymousResult]-}) movePair |	-- Discard the opponent's matching move, but cite the names of archived games it reached.@@ -251,7 +252,7 @@ 				) . #endif 				map (-					id &&& (`findNextOnymousQualifiedMovesForPosition` positionHashQualifiedMoveTree) . (`Model.Game.applyQualifiedMove` game)	-- Apply this player's move.+					id &&& findNextOnymousQualifiedMovesForPosition positionHashQualifiedMoveTree . (`Model.Game.applyQualifiedMove` game)	-- Apply this player's move. 				) $ Model.Game.findQualifiedMovesAvailableToNextPlayer game 	] -- List-comprehension. @@ -270,6 +271,14 @@ -- | 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 +-- | Transform an arbitrary match-function to operate on the colour-flipped game.+colourFlipper :: FindMatch positionHash -> FindMatch positionHash+colourFlipper findMatch positionHashQualifiedMoveTree	= map (+	Property.Reflectable.reflectOnX {-reflect matching moves back into the original domain-} *** map (+		Control.Arrow.first $ showString "Colour-flipped:\t"+	)+ ) . findMatch positionHashQualifiedMoveTree . Property.Reflectable.reflectOnX+ {- | 	* Calls 'findNextOnymousQualifiedMovesForGame' to find an exact match for the current /game/ in the tree. @@ -287,32 +296,23 @@ 	:: 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.+findNextOnymousQualifiedMoves (tryToMatchMoves, tryToMatchViaJoiningMove, tryToMatchColourFlippedPosition) positionHashQualifiedMoveTree game+	| cantConverge positionHashQualifiedMoveTree game	= []	-- The specified game is smaller than any defined in the tree. 	| otherwise						= Data.Maybe.fromMaybe [] . Data.List.find ( 		not . null	-- Accept the results from the first match-function which returns any. 	) $ ( 		if tryToMatchMoves-			then (findNextOnymousQualifiedMovesForGame game positionHashQualifiedMoveTree :)+			then (findNextOnymousQualifiedMovesForGame positionHashQualifiedMoveTree game :) 			else id 	) [-		colourFlipper findMatch game positionHashQualifiedMoveTree |+		transformation findMatch positionHashQualifiedMoveTree game | 			findMatch	<- findNextOnymousQualifiedMovesForPosition : [findNextJoiningOnymousQualifiedMovesFromPosition | tryToMatchViaJoiningMove] {-list-comprehension-},-			colourFlipper	<- id : [-				\findMatch' game' -> map (-					Property.Reflectable.reflectOnX {-reflect matching moves back into the original domain-} *** map (-						Control.Arrow.first $ showString "Colour-flipped:\t"-					)-				) . findMatch' (-					Property.Reflectable.reflectOnX game'-				) | tryToMatchColourFlippedPosition-			] -- Transform an arbitrary match-function to operate on either the original or the colour-flipped game.+			transformation	<- id : [colourFlipper | tryToMatchColourFlippedPosition] -- 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.+	:: Colour.LogicalColour.LogicalColour	-- ^ The player who is next to move. 	-> [OnymousQualifiedMove] 	-> [OnymousQualifiedMove] shortListMostVictorious nextLogicalColour	= last {-highest scoring group-} . Data.List.Extra.groupSortOn (@@ -331,19 +331,10 @@ 	=> randomGen 	-> PreferVictories 	-> MatchSwitches-	-> Model.Game.Game 	-> PositionHashQualifiedMoveTree positionHash-	-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name])-{-# SPECIALISE maybeRandomlySelectOnymousQualifiedMove-	:: System.Random.RandomGen randomGen-	=> randomGen-	-> PreferVictories-	-> MatchSwitches 	-> Model.Game.Game-	-> PositionHashQualifiedMoveTree Type.Crypto.PositionHash 	-> Maybe (Component.QualifiedMove.QualifiedMove, [ContextualNotation.QualifiedMoveForest.Name])- #-}-maybeRandomlySelectOnymousQualifiedMove randomGen preferVictories matchSwitches game positionHashQualifiedMoveTree	= case findNextOnymousQualifiedMoves matchSwitches game positionHashQualifiedMoveTree of+maybeRandomlySelectOnymousQualifiedMove randomGen preferVictories matchSwitches positionHashQualifiedMoveTree game	= case findNextOnymousQualifiedMoves matchSwitches positionHashQualifiedMoveTree game of 	[]			-> Nothing 	onymousQualifiedMoves	-> fmap ( 		Control.Arrow.second $ Data.List.nub . map fst {-Name-}

@@ -151,8 +151,8 @@ 	mkCompositeIdentifier	= unwords . map snd {-value-} . ContextualNotation.PGN.getIdentificationTagPairs  	merge-		:: OnymousResult				-- ^ The name of this move-sequence, & the result.-		-> [Component.QualifiedMove.QualifiedMove]	-- ^ A chronological sequence of /qualified move/s.+		:: OnymousResult					-- ^ The name of this move-sequence, & the result.+		-> Component.QualifiedMove.QualifiedMoveSequence	-- ^ A chronological sequence of /qualified move/s. 		-> [QualifiedMoveTree] 		-> [QualifiedMoveTree] 	merge onymousResult qualifiedMoves@(qualifiedMove : remainingQualifiedMoves) forest	= case span (@@ -172,7 +172,7 @@ 		_ {-no match-}						-> mkLinkedList onymousResult qualifiedMoves : forest 	merge _ [] forest					= forest -	mkLinkedList :: OnymousResult -> [Component.QualifiedMove.QualifiedMove] -> QualifiedMoveTree+	mkLinkedList :: OnymousResult -> Component.QualifiedMove.QualifiedMoveSequence -> QualifiedMoveTree 	mkLinkedList onymousResult ~(qualifiedMove : remainingQualifiedMoves) 		| null remainingQualifiedMoves	= Data.Tree.Node { 			Data.Tree.rootLabel	= (qualifiedMove, Just onymousResult),@@ -198,6 +198,7 @@ findMinimumPieces	= slave ( 	2 * Component.Piece.nPiecesPerSide	-- CAVEAT: assuming a conventional starting position.  ) . deconstruct where+	slave :: Type.Count.NPieces -> [QualifiedMoveTree] -> Type.Count.NPieces 	slave nPieces []	= nPieces 	slave nPieces forest	= minimum $ map ( 		\Data.Tree.Node {@@ -211,6 +212,7 @@ -- | Count the number of /game/s & distinct /positions/. count :: QualifiedMoveForest -> (Type.Count.NGames, Type.Count.NPositions) count	= slave . deconstruct where+	slave :: [QualifiedMoveTree] -> (Type.Count.NGames, Type.Count.NPositions) 	slave	= Data.List.foldl' ( 		\(nGames, nPositions) Data.Tree.Node { 			Data.Tree.rootLabel	= (_, maybeOnymousResult),@@ -238,6 +240,7 @@ } where 	initialGame	= Data.Default.def +	slave :: Model.Game.Game -> QualifiedMoveTree -> Model.GameTree.BareGameTree 	slave game Data.Tree.Node { 		Data.Tree.rootLabel	= (qualifiedMove, _), 		Data.Tree.subForest	= qualifiedMoveForest'

@@ -157,7 +157,7 @@ 	-> Model.Game.Game	-- ^ The /game/ prior to application of the specified /turn/. 	-> ShowS showsTurn explicitEnPassant turn game-	| Just sourceRank <- fmap Component.Piece.getRank . State.MaybePieceByCoordinates.dereference source $ State.Board.getMaybePieceByCoordinates board	= (+	| Just sourceRank <- Component.Piece.getRank <$> State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) source	= ( 		if sourceRank == Attribute.Rank.Pawn 			then ( 				if isCapture@@ -175,9 +175,9 @@ 					then shortCastleToken 					else longCastleToken 				_ {-not a castling-}			-> showsRank sourceRank . (-					case Data.List.delete source {-search for alternatives-} $ State.Board.findAttacksBy (+					case Data.List.delete source {-search for alternatives-} $ State.Board.findAttacksBy board ( 						Component.Piece.mkPiece (Model.Game.getNextLogicalColour game) sourceRank-					) destination board of+					) destination of 						[]		-> id	-- There're aren't any pieces of this rank which can perform this move. 						coordinates	-> case any ( 							(== Cartesian.Coordinates.getX source) . Cartesian.Coordinates.getX@@ -206,7 +206,7 @@  		isEnPassant, isCapture :: Bool 		isEnPassant	= Attribute.MoveType.isEnPassant moveType-		isCapture	= State.MaybePieceByCoordinates.isOccupied destination (State.Board.getMaybePieceByCoordinates board) || isEnPassant+		isCapture	= State.MaybePieceByCoordinates.isOccupied (State.Board.getMaybePieceByCoordinates board) destination || isEnPassant  		showsRank :: Attribute.Rank.Rank -> ShowS 		showsRank rank	= showChar $ fromRank rank@@ -290,7 +290,7 @@ 	nextLogicalColour			= Model.Game.getNextLogicalColour game 	(longCastlingMove, shortCastlingMove)	= Component.CastlingMove.getLongAndShortMoves nextLogicalColour 	board					= Model.Game.getBoard game-	getMaybePiece				= (`State.MaybePieceByCoordinates.dereference` State.Board.getMaybePieceByCoordinates board)+	getMaybePiece				= State.MaybePieceByCoordinates.dereference $ State.Board.getMaybePieceByCoordinates board 	getMaybeRank				= fmap Component.Piece.getRank . getMaybePiece  in do 	qualifiedMove	<- Text.Poly.spaces >> Poly.oneOf' [@@ -303,7 +303,7 @@ 					piece :: Component.Piece.Piece 					piece	= Component.Piece.mkPiece nextLogicalColour rank -					findAttacksBy destination	= State.Board.findAttacksBy piece destination board+					findAttacksBy destination	= State.Board.findAttacksBy board piece destination  				if rank == Attribute.Rank.Pawn 					then let@@ -378,7 +378,7 @@ 								show &&& return {-to Parser-monad-} $ qualifiedMove | 									source	<- sourceCandidates,-- Attempt to resolve the ambiguity by playing subsequent moves. 									let qualifiedMove	= Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,-									Model.Game.isValidQualifiedMove qualifiedMove game+									Model.Game.isValidQualifiedMove game qualifiedMove 							 ] -- List-comprehension. 					in Poly.oneOf' [ 						(@@ -431,16 +431,18 @@  	_	<- Control.Applicative.optional (Poly.satisfyMsg (`elem` [checkFlag, checkMateFlag]) "Check") >> Control.Applicative.optional moveSuffixAnnotationParser -	fmap fromQualifiedMove $ if validateMoves-		then Data.Maybe.maybe (return {-to Parser-monad-} qualifiedMove) (Poly.failBad . showString "failed: ") $ Model.Game.validateQualifiedMove qualifiedMove game-		else return {-to Parser-monad-} qualifiedMove+	fromQualifiedMove `fmap` (+		if validateMoves+			then Data.Maybe.maybe (return {-to Parser-monad-} qualifiedMove) (Poly.failBad . showString "failed: ") . Model.Game.validateQualifiedMove game+			else return {-to Parser-monad-}+	 ) qualifiedMove #else /* Parsec */ 	-> Parsec.Parser StandardAlgebraic parser explicitEnPassant validateMoves game	= let 	nextLogicalColour			= Model.Game.getNextLogicalColour game 	(longCastlingMove, shortCastlingMove)	= Component.CastlingMove.getLongAndShortMoves nextLogicalColour 	board					= Model.Game.getBoard game-	getMaybePiece				= (`State.MaybePieceByCoordinates.dereference` State.Board.getMaybePieceByCoordinates board)+	getMaybePiece				= State.MaybePieceByCoordinates.dereference $ State.Board.getMaybePieceByCoordinates board 	getMaybeRank				= fmap Component.Piece.getRank . getMaybePiece  in do 	qualifiedMove	<- Parsec.spaces >> Parsec.choice [@@ -451,7 +453,7 @@ 				piece :: Component.Piece.Piece 				piece	= Component.Piece.mkPiece nextLogicalColour rank -				findAttacksBy destination	= State.Board.findAttacksBy piece destination board+				findAttacksBy destination	= State.Board.findAttacksBy board piece destination  			if rank == Attribute.Rank.Pawn 				then let@@ -506,7 +508,7 @@ 							Parsec.try $ return {-to ParsecT-monad-} qualifiedMove | 								source	<- sourceCandidates,-- Attempt to resolve the ambiguity by playing subsequent moves. 								let qualifiedMove	= Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) $ mkNormalMoveType destination,-								Model.Game.isValidQualifiedMove qualifiedMove game+								Model.Game.isValidQualifiedMove game qualifiedMove 						 ] -- List-comprehension. 				in Parsec.choice [ 					Parsec.try $ do -- N.B. this scenario occurs when there are identical pieces on both the same row & the same column, as the intended attacker; i.e. after a promotion.@@ -553,9 +555,11 @@  	_	<- Parsec.optional (Parsec.oneOf [checkFlag, checkMateFlag] <?> "Check") >> Parsec.optional moveSuffixAnnotationParser -	fromQualifiedMove <$> if validateMoves-		then Data.Maybe.maybe (return {-to ParsecT-monad-} qualifiedMove) (fail . showString "Failed: ") $ Model.Game.validateQualifiedMove qualifiedMove game-		else return {-to ParsecT-monad-} qualifiedMove+	fromQualifiedMove <$> (+		if validateMoves+			then Data.Maybe.maybe (return {-to ParsecT-monad-} qualifiedMove) (fail . showString "Failed: ") . Model.Game.validateQualifiedMove game+			else return {-to ParsecT-monad-}+	 ) qualifiedMove #endif  -- | Represent a /rank/ in SAN.

@@ -35,6 +35,7 @@ -- ** Mutators 	promote, 	reduce,+	prune, 	mapForest ) where @@ -77,7 +78,7 @@ 		\Data.Tree.Node { 			Data.Tree.rootLabel	= rootLabel, 			Data.Tree.subForest	= subForest-		} -> (rootLabel :) `fmap` slave subForest remainingData {-recurse-}+		} -> (rootLabel :) <$> slave subForest remainingData {-recurse-} 	 ) 	slave _ _				= Just [] @@ -97,7 +98,7 @@ 			\forest'' -> match { 				Data.Tree.subForest	= forest'' 			} : mismatches ++ remainingNodes-		 ) `fmap` slave remainingData forest'	-- Recurse.+		 ) <$> slave remainingData forest'	-- Recurse. 		_											-> Nothing	-- Match-failure. 	slave _ forest				= Just forest	-- Data exhausted => Terminate normally. @@ -110,6 +111,18 @@  -- | The type of a function which changes the structure (but not the type) of the specified tree. type Transformation a	= Data.Tree.Tree a -> Data.Tree.Tree a++-- | Remove branches after the specified depth.+prune :: Int -> Transformation a+prune depth tree@Data.Tree.Node { Data.Tree.subForest = forest }+	| depth < 0	= error "BishBosh.Data.RoseTree.prune:\tdepth can't be negative."+	| otherwise	= tree {+		Data.Tree.subForest	= if depth == 0+			then []+			else map (+				prune $ pred depth	-- Recurse.+			) forest+	}  {- | 	* Apply an arbitrary mapping to all subForests; cf. 'fmap' which applies an arbitrary function to all 'Data.Tree.rootLabel's.

@@ -0,0 +1,114 @@+{-+	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@]++	* Describes the directional components of a diagonal line.+-}++module BishBosh.Direction.Diagonal(+-- * Types+-- ** Data-types+	Diagonal()+) where++import			Control.Arrow((***))+import qualified	BishBosh.Direction.Horizontal		as Direction.Horizontal+import qualified	BishBosh.Direction.Vertical		as Direction.Vertical+import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable+import qualified	BishBosh.Property.Orientated		as Property.Orientated+import qualified	BishBosh.Property.Reflectable		as Property.Reflectable+import qualified	Control.DeepSeq+import qualified	Data.List.Extra++-- | Directions at 45 degress to all edges of the board; those in which a Bishop can move.+data Diagonal	= MkDiagonal {+	getVertical	:: Direction.Vertical.Vertical,		-- ^ The vertical component of the diagonal.+	getHorizontal	:: Direction.Horizontal.Horizontal	-- ^ The horizontal component of the diagonal.+} deriving (Eq, Ord)++instance Control.DeepSeq.NFData Diagonal where+	rnf MkDiagonal {+		getVertical	= _,+		getHorizontal	= _+	} = ()++instance Enum Diagonal where+	fromEnum MkDiagonal {+		getVertical	= v,+		getHorizontal	= h+	} = fromIntegral Direction.Vertical.nVerticals * fromEnum v + fromEnum h++	toEnum i	= uncurry MkDiagonal . (toEnum *** toEnum) $! i `divMod` fromIntegral Direction.Vertical.nVerticals++instance Show Diagonal where+	showsPrec precedence MkDiagonal {+		getVertical	= v,+		getHorizontal	= h+	} = showsPrec precedence v . showsPrec precedence h++instance Read Diagonal where+	readsPrec precedence s	= case readsPrec precedence $ Data.List.Extra.trimStart s of+		[(vertical, s')]	-> case readsPrec precedence s' of+			[(horizontal, s'')]	-> [+				(+					MkDiagonal {+						getVertical	= vertical,+						getHorizontal	= horizontal+					},+					s''+				) -- Pair.+			 ] -- Singleton.+			_			-> []	-- No parse.+		_			-> []	-- No parse.++instance Property.FixedMembership.FixedMembership Diagonal where+	members	= map MkDiagonal Property.FixedMembership.members {-vertical-} <*> Property.FixedMembership.members {-horizontal-}++instance Property.Opposable.Opposable Diagonal where+	getOpposite MkDiagonal {+		getVertical	= v,+		getHorizontal	= h+	} = MkDiagonal {+		getVertical	= Property.Opposable.getOpposite v,+		getHorizontal	= Property.Opposable.getOpposite h+	}++instance Property.Orientated.Orientated Diagonal where+	isParallel	= const False+	isDiagonal	= const True+	isStraight	= const True++instance Property.Reflectable.ReflectableOnX Diagonal where+	reflectOnX diagonal@MkDiagonal {+		getVertical	= v+	} = diagonal {+		getVertical	= Property.Reflectable.reflectOnX v+	}++instance Property.Reflectable.ReflectableOnY Diagonal where+	reflectOnY diagonal@MkDiagonal {+		getHorizontal	= h+	} = diagonal {+		getHorizontal	= Property.Reflectable.reflectOnY h+	}+

@@ -0,0 +1,180 @@+{-+	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@]++	* Describes a /direction/.++	* The resolution of the measure is merely sufficient for Chess-moves.++	* The IO-format is based on 8 points of the compass.+-}++module BishBosh.Direction.Direction(+-- * Types+-- ** Type-synonyms+	ArrayByDirection,+-- ** Data-types+	Direction(),+-- * Constants+	parallels,+	s,+	n,+	w,+	e,+	diagonals,+	sw,+	se,+	nw,+	ne,+	opposites,+-- * Functions+	attackDirectionsForPawn,+	listArrayByDirection,+-- ** Predicates+	areAligned+) where++import			Control.Arrow((&&&), (|||), (+++))+import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour+import qualified	BishBosh.Direction.Diagonal		as Direction.Diagonal+import qualified	BishBosh.Direction.Parallel		as Direction.Parallel+import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable+import qualified	BishBosh.Property.Orientated		as Property.Orientated+import qualified	BishBosh.Property.Reflectable		as Property.Reflectable+import qualified	BishBosh.Property.Rotatable		as Property.Rotatable+import qualified	Control.DeepSeq+import qualified	Data.Array.IArray+import qualified	Data.List.Extra++-- | Define the /direction/ in which a piece moves relative to the board's edges.+newtype Direction	= MkDirection (Either Direction.Parallel.Parallel Direction.Diagonal.Diagonal) deriving (Eq, Ord)++instance Control.DeepSeq.NFData Direction where+	rnf (MkDirection d)	= Control.DeepSeq.rnf ||| Control.DeepSeq.rnf $ d++instance Show Direction where+	showsPrec precedence (MkDirection d)	= showsPrec precedence ||| showsPrec precedence $ d++instance Read Direction where+	readsPrec precedence string	= let+		s'	= Data.List.Extra.trimStart string+	 in case readsPrec precedence s' of+		[(diagonal, s'')]	-> [(MkDirection $ Right diagonal, s'')]+		_			-> case readsPrec precedence s' of+			[(parallel, s'')]	-> [(MkDirection $ Left parallel, s'')]+			_			-> []	-- No parse.++instance Property.Opposable.Opposable Direction where+	getOpposite (MkDirection d)	= MkDirection $ (Property.Opposable.getOpposite +++ Property.Opposable.getOpposite) d++instance Property.Orientated.Orientated Direction where+	isVertical (MkDirection (Left p))	= Property.Orientated.isVertical p+	isVertical _				= False++	isHorizontal (MkDirection (Left p))	= Property.Orientated.isHorizontal p+	isHorizontal _				= False++	isParallel (MkDirection (Left _))	= True+	isParallel _				= False++	isDiagonal (MkDirection (Right _))	= True+	isDiagonal _				= False++	isStraight				= const True++instance Property.Reflectable.ReflectableOnX Direction where+	reflectOnX (MkDirection d)	= MkDirection $ (Property.Reflectable.reflectOnX +++ Property.Reflectable.reflectOnX) d++instance Property.Reflectable.ReflectableOnY Direction where+	reflectOnY (MkDirection d)	= MkDirection $ (Property.Reflectable.reflectOnY +++ Property.Reflectable.reflectOnY) d++instance Property.Rotatable.Rotatable Direction where+	rotate90 direction+		| Property.Orientated.isParallel direction	= rotateParallel+		| otherwise					= rotateDiagonal+		where+			rotateParallel+				| Property.Orientated.isVertical direction	= rotateVertical+				| otherwise					= rotateHorizontal+				where+					rotateVertical+						| direction == s	= e+						| otherwise {-n-}	= w++					rotateHorizontal+						| direction == w	= s+						| otherwise {-e-}	= n+			rotateDiagonal+				| direction == sw	= se+				| direction == se	= ne+				| direction == nw	= sw+				| otherwise {-ne-}	= nw++	rotate180	= Property.Opposable.getOpposite++instance Property.FixedMembership.FixedMembership Direction where+	members	= parallels ++ diagonals++instance Bounded Direction where+	minBound	= head Property.FixedMembership.members+	maxBound	= last Property.FixedMembership.members++instance Data.Array.IArray.Ix Direction where+	range _			= Property.FixedMembership.members+	inRange _ _		= True+	index _ (MkDirection d)	= fromEnum ||| (+ fromIntegral Direction.Parallel.nParallels) . fromEnum $ d++-- | Constant directions.+parallels	:: [Direction]+s, n, w, e	:: Direction+parallels@[s, n, w, e]	= map (MkDirection . Left) Property.FixedMembership.members {-parallels-}++-- | Constant directions.+diagonals	:: [Direction]+sw, se, nw, ne	:: Direction+diagonals@[sw, se, nw, ne]	= map (MkDirection . Right) Property.FixedMembership.members++{- |+	* Returns a list of /direction/s, each paired with its anti-parallel.++	* CAVEAT: each /direction/ only appears once in the list, on an arbitrary side of a pair.+-}+opposites :: [(Direction, Direction)]+opposites	= map (id &&& Property.Opposable.getOpposite) [n, ne, e, se]++-- | The /direction/s in which a @Pawn@ can attack.+attackDirectionsForPawn :: Colour.LogicalColour.LogicalColour -> [Direction]+attackDirectionsForPawn Colour.LogicalColour.Black	= [sw, se]+attackDirectionsForPawn _				= [nw, ne]++-- | Whether the two /direction/s specified, are either parallel or anti-parallel.+areAligned :: Direction -> Direction -> Bool+areAligned l	= uncurry (||) . ((== l) &&& (== l) . Property.Opposable.getOpposite)++-- | A boxed array indexed by /direction/, of arbitrary elements.+type ArrayByDirection	= Data.Array.IArray.Array {-Boxed-} Direction++-- | Array-constructor.+listArrayByDirection :: Data.Array.IArray.IArray a e => [e] -> a Direction e+listArrayByDirection	= Data.Array.IArray.listArray (minBound, maxBound)+

@@ -0,0 +1,66 @@+{-+	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@]++	* Describes the direction of a rank of the board.+-}++module BishBosh.Direction.Horizontal(+-- * Types+-- ** Data-types+	Horizontal(),+-- * Constants+--	range,+	nHorizontals+) where++import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable+import qualified	BishBosh.Property.Reflectable		as Property.Reflectable+import qualified	BishBosh.Type.Count			as Type.Count++-- | The sum-type of orientations of all lines of constant rank.+data Horizontal	= W | E deriving (Enum, Eq, Ord, Show)++instance Read Horizontal where+	readsPrec _ ('W' : s)	= [(W, s)]+	readsPrec _ ('E' : s)	= [(E, s)]+	readsPrec _ _		= []	-- No parse.++instance Property.FixedMembership.FixedMembership Horizontal where+	members	= range++instance Property.Opposable.Opposable Horizontal where+	getOpposite W	= E+	getOpposite E	= W++instance Property.Reflectable.ReflectableOnY Horizontal where+	reflectOnY	= Property.Opposable.getOpposite++-- | Constant range of values.+range :: [Horizontal]+range	= [ toEnum 0 .. ]++-- | The number of verticals directions.+nHorizontals :: Type.Count.NDirections+nHorizontals	= fromIntegral $ length range+

@@ -0,0 +1,104 @@+{-+	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@]++	* Describes the directional components of a line parallel to an edge of the board.+-}++module BishBosh.Direction.Parallel(+-- * Types+-- ** Data-types+	Parallel(),+-- * Constants+--	range,+	nParallels+) where++import			Control.Arrow((|||), (+++))+import qualified	BishBosh.Direction.Horizontal		as Direction.Horizontal+import qualified	BishBosh.Direction.Vertical		as Direction.Vertical+import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable+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	Control.DeepSeq+import qualified	Data.List.Extra++-- | Directions parallel to two edges of the board; those in which a Rook can move.+newtype Parallel	= MkParallel (Either Direction.Vertical.Vertical Direction.Horizontal.Horizontal) deriving (Eq, Ord)++instance Control.DeepSeq.NFData Parallel where+	rnf (MkParallel p)	= Control.DeepSeq.rwhnf ||| Control.DeepSeq.rwhnf $ p++instance Enum Parallel where+	fromEnum (MkParallel p)	= fromEnum ||| (+ fromIntegral Direction.Vertical.nVerticals) . fromEnum $ p++	toEnum i	= MkParallel $! case i `divMod` fromIntegral Direction.Vertical.nVerticals of+		(0, remainder)	-> Left $! toEnum remainder+		(~1, remainder)	-> Right $! toEnum remainder++instance Show Parallel where+	showsPrec precedence (MkParallel p)	= showsPrec precedence ||| showsPrec precedence $ p++instance Read Parallel where+	readsPrec precedence s	= let+		s'	= Data.List.Extra.trimStart s+	 in case readsPrec precedence s' of+		[(vertical, s'')]	-> [(MkParallel $ Left vertical, s'')]+		_			-> case readsPrec precedence s' of+			[(horizontal, s'')]	-> [(MkParallel $ Right horizontal, s'')]+			_			-> []	-- No parse.++instance Property.FixedMembership.FixedMembership Parallel where+	members	= range++instance Property.Opposable.Opposable Parallel where+	getOpposite (MkParallel p)	= MkParallel $ (Property.Opposable.getOpposite +++ Property.Opposable.getOpposite) p++instance Property.Orientated.Orientated Parallel where+	isVertical (MkParallel (Left _))	= True+	isVertical _				= False++	isHorizontal (MkParallel (Right _))	= True+	isHorizontal _				= False++	isParallel	= const True++	isDiagonal	= const False++	isStraight	= const True++instance Property.Reflectable.ReflectableOnX Parallel where+	reflectOnX (MkParallel p)	= MkParallel $ (Property.Reflectable.reflectOnX +++ id) p++instance Property.Reflectable.ReflectableOnY Parallel where+	reflectOnY (MkParallel p)	= MkParallel $ (id +++ Property.Reflectable.reflectOnY) p++-- | Constant range of values.+range :: [Parallel]+range	= take (fromIntegral $ Direction.Vertical.nVerticals + Direction.Horizontal.nHorizontals) [ toEnum 0 .. ]++-- | The number of verticals directions.+nParallels :: Type.Count.NDirections+nParallels	= fromIntegral $ length range+

@@ -0,0 +1,66 @@+{-+	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@]++	* Describes the direction of a file of the board.+-}++module BishBosh.Direction.Vertical(+-- * Types+-- ** Data-types+	Vertical(),+-- * Constants+--	verticals,+	nVerticals+) where++import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership+import qualified	BishBosh.Property.Opposable		as Property.Opposable+import qualified	BishBosh.Property.Reflectable		as Property.Reflectable+import qualified	BishBosh.Type.Count			as Type.Count++-- | The sum-type of orientations of all lines of constant file.+data Vertical	= S | N deriving (Enum, Eq, Ord, Show)++instance Read Vertical where+	readsPrec _ ('S' : s)	= [(S, s)]+	readsPrec _ ('N' : s)	= [(N, s)]+	readsPrec _ _		= []	-- No parse.++instance Property.FixedMembership.FixedMembership Vertical where+	members	= verticals++instance Property.Opposable.Opposable Vertical where+	getOpposite S	= N+	getOpposite N	= S++instance Property.Reflectable.ReflectableOnX Vertical where+	reflectOnX	= Property.Opposable.getOpposite++-- | Constant range of values.+verticals :: [Vertical]+verticals	= [ toEnum 0 .. ]++-- | The number of verticals directions.+nVerticals :: Type.Count.NDirections+nVerticals	= fromIntegral $ length verticals+

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, FlexibleContexts #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -34,8 +33,8 @@ --	maximumDestinations, 	maximumDefended, -- * Functions-	measurePieceSquareValue,-	measurePieceSquareValueIncrementally,+	measurePieceSquareValueDifference,+	measurePieceSquareValueDifferenceIncrementally, 	measureValueOfMaterial, --	measureValueOfMobility, 	measureValueOfCastlingPotential,@@ -49,11 +48,11 @@ import			Control.Applicative((<|>)) import			Control.Arrow((&&&)) import			Data.Array.IArray((!))-import qualified	BishBosh.Attribute.LogicalColour			as Attribute.LogicalColour import qualified	BishBosh.Attribute.MoveType				as Attribute.MoveType 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.Colour.LogicalColour				as Colour.LogicalColour import qualified	BishBosh.Component.Move					as Component.Move import qualified	BishBosh.Component.Piece				as Component.Piece import qualified	BishBosh.Component.PieceSquareByCoordinatesByRank	as Component.PieceSquareByCoordinatesByRank@@ -78,49 +77,34 @@ import qualified	Data.Map.Strict						as Map import qualified	Data.Maybe -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif---- | Measures the piece-square value from the perspective of the last player to move.-measurePieceSquareValue :: (-#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).-#endif-	Num				pieceSquareValue- )-	=> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue+-- | Measures the difference in piece-square value between players, from the perspective of the last player to move.+measurePieceSquareValueDifference+	:: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank 	-> Model.Game.Game-	-> pieceSquareValue-{-# SPECIALISE measurePieceSquareValue :: Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank Type.Mass.PieceSquareValue -> Model.Game.Game -> Type.Mass.PieceSquareValue #-}-measurePieceSquareValue pieceSquareByCoordinatesByRank game	= (-	if Attribute.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game+	-> Type.Mass.Base+measurePieceSquareValueDifference pieceSquareByCoordinatesByRank game	= (+	if Colour.LogicalColour.isBlack $! Model.Game.getNextLogicalColour game 		then id-		else negate	-- Represent the piece-square value from Black's perspective.- ) $ whitesPieceSquareValue - blacksPieceSquareValue where+		else negate	-- Represent the piece-square value difference from Black's perspective.+ ) $! whitesPieceSquareValue - blacksPieceSquareValue where 	[blacksPieceSquareValue, whitesPieceSquareValue]	= Data.Array.IArray.elems . State.Board.sumPieceSquareValueByLogicalColour pieceSquareByCoordinatesByRank $ Model.Game.getBoard game  {- |-	* Measures the piece-square value from the perspective of the last player to move.+	* Measures the difference in piece-square value between players, from the perspective of the last player to move.  	* The previous value is provided, to enable calculation by difference. -	* N.B.: because of diminishing returns, the piece-square value for everything but quiet moves is calculated from scratch.+	* N.B.: because of diminishing returns, the piece-square value for everything but simple moves is calculated from scratch. -}-measurePieceSquareValueIncrementally :: (-#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).-#endif-	Num				pieceSquareValue- )-	=> pieceSquareValue	-- ^ The value before the last move was applied, & therefore also from the perspective of the previous player.-	-> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue+measurePieceSquareValueDifferenceIncrementally+	:: Type.Mass.Base	-- ^ The difference between players in the piece-square value, before the last move was applied & therefore also from the perspective of the previous player.+	-> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank 	-> Model.Game.Game-	-> pieceSquareValue-{-# SPECIALISE measurePieceSquareValueIncrementally :: Type.Mass.PieceSquareValue -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank Type.Mass.PieceSquareValue -> Model.Game.Game -> Type.Mass.PieceSquareValue #-}-measurePieceSquareValueIncrementally previousPieceSquareValue pieceSquareByCoordinatesByRank game-	| Attribute.MoveType.isSimple $ Component.QualifiedMove.getMoveType qualifiedMove	= let-		findPieceSquareValue	= uncurry (+	-> Type.Mass.Base+measurePieceSquareValueDifferenceIncrementally previousPieceSquareValueDifference pieceSquareByCoordinatesByRank game+	| Attribute.MoveType.isSimple $! Component.QualifiedMove.getMoveType qualifiedMove	= let+		findPieceSquareValue :: Cartesian.Coordinates.Coordinates -> Type.Mass.Base+		findPieceSquareValue	= realToFrac . uncurry ( 			Component.PieceSquareByCoordinatesByRank.findPieceSquareValue pieceSquareByCoordinatesByRank 		 ) ( 			State.Board.getNPieces {- N.B.: no capture occurred-} . Model.Game.getBoard &&& Property.Opposable.getOpposite . Model.Game.getNextLogicalColour $ game	{-the last player to move-}@@ -129,8 +113,8 @@ 		 ) 	in uncurry (-) ( 		findPieceSquareValue . Component.Move.getDestination &&& findPieceSquareValue . Component.Move.getSource $ Component.QualifiedMove.getMove qualifiedMove-	) - previousPieceSquareValue {-from the previous player's perspective-}-	| otherwise	= measurePieceSquareValue pieceSquareByCoordinatesByRank game	-- N.B.: though non-simple (Castling, En-passant, promotion) can be calculated, the returns don't justify the effort.+	) - previousPieceSquareValueDifference {-from the previous player's perspective-}+	| otherwise	= measurePieceSquareValueDifference pieceSquareByCoordinatesByRank game	-- N.B.: though non-simple (Castling, En-passant, promotion) can be calculated, the returns don't justify the effort. 	where 		Just turn	= Model.Game.maybeLastTurn game 		qualifiedMove	= Component.Turn.getQualifiedMove turn@@ -144,14 +128,14 @@ measureValueOfMaterial rankValues maximumTotalRankValue game	= realToFrac . ( 	/ maximumTotalRankValue	-- Normalise.  ) . (-	if Attribute.LogicalColour.isBlack $ Model.Game.getNextLogicalColour game+	if Colour.LogicalColour.isBlack $! Model.Game.getNextLogicalColour game 		then id		-- White just moved. 		else negate	-- Black just moved.  ) . Data.List.foldl' ( 	\acc (rank, nPiecesDifference) -> if nPiecesDifference == 0 		then acc	-- Avoid calling 'Input.RankValues.findRankValue'. 		else acc + realToFrac (-			Input.RankValues.findRankValue rank rankValues+			Input.RankValues.findRankValue rankValues rank 		) * fromIntegral nPiecesDifference  ) 0 . Data.Array.IArray.assocs . State.Board.getNPiecesDifferenceByRank {-which arbitrarily counts White pieces as positive & Black as negative-} $ Model.Game.getBoard game @@ -178,20 +162,20 @@ measureValueOfMobility :: Model.Game.Game -> Metric.CriterionValue.CriterionValue measureValueOfMobility game	= realToFrac . uncurry (-) . ( 	measureConstriction &&& measureConstriction . Property.Opposable.getOpposite {-recent mover-}- ) $ Model.Game.getNextLogicalColour game where-	measureConstriction :: Attribute.LogicalColour.LogicalColour -> Type.Mass.CriterionValue-	measureConstriction logicalColour	= recip . fromIntegral {-NPlies-} . succ {-avoid divide-by-zero-} $ Model.Game.countPliesAvailableTo logicalColour game+ ) $! Model.Game.getNextLogicalColour game where+	measureConstriction :: Colour.LogicalColour.LogicalColour -> Type.Mass.CriterionValue+	measureConstriction logicalColour	= recip . fromIntegral {-NPlies-} . succ {-avoid divide-by-zero-} $ Model.Game.countPliesAvailableTo game logicalColour  -- | Measure the arithmetic difference between the potential to /Castle/, on either side. measureValueOfCastlingPotential :: Model.Game.Game -> Metric.CriterionValue.CriterionValue measureValueOfCastlingPotential game	= realToFrac . uncurry (-) . ( 	castlingPotential . Property.Opposable.getOpposite {-recent mover-} &&& castlingPotential  ) $ Model.Game.getNextLogicalColour game where-	castlingPotential :: Attribute.LogicalColour.LogicalColour -> Type.Mass.CriterionValue+	castlingPotential :: Colour.LogicalColour.LogicalColour -> Type.Mass.CriterionValue 	castlingPotential	= Data.Maybe.maybe 1 {-have Castled-} ( 		(/ 2) . fromIntegral . length-	 ) . (-		`State.CastleableRooksByLogicalColour.locateForLogicalColour` Model.Game.getCastleableRooksByLogicalColour game+	 ) . State.CastleableRooksByLogicalColour.locateForLogicalColour (+		Model.Game.getCastleableRooksByLogicalColour game 	 )  {- |@@ -209,7 +193,7 @@  ) . fromIntegral {-NPieces-} . uncurry (-) . ( 	countDoubledPawns &&& countDoubledPawns . Property.Opposable.getOpposite {-recent mover-}  ) $ Model.Game.getNextLogicalColour game where-	countDoubledPawns :: Attribute.LogicalColour.LogicalColour -> Type.Count.NPieces+	countDoubledPawns :: Colour.LogicalColour.LogicalColour -> Type.Count.NPieces 	countDoubledPawns logicalColour	= uncurry (-) . ( 		Data.Foldable.foldl' (+) 0 &&& fromIntegral . Data.Foldable.length {-one Pawn can't be considered to be doubled, so substract one Pawn per column-} 	 ) $ State.Board.getNPawnsByFileByLogicalColour (Model.Game.getBoard game) ! logicalColour@@ -227,7 +211,7 @@  ) . fromIntegral {-NPieces-} . uncurry (-) . ( 	countIsolatedPawns &&& countIsolatedPawns . Property.Opposable.getOpposite {-recent mover-}  ) $ Model.Game.getNextLogicalColour game where-	countIsolatedPawns :: Attribute.LogicalColour.LogicalColour -> Type.Count.NPieces+	countIsolatedPawns :: Colour.LogicalColour.LogicalColour -> Type.Count.NPieces 	countIsolatedPawns logicalColour	= Map.foldlWithKey' ( 		\acc x nPawns -> if (`Map.member` nPawnsByFile) `any` Cartesian.Abscissa.getAdjacents x 			then acc		-- This file has at least one neighbouring Pawn which can (if at a suitable rank) be used to protect any of those in this file.@@ -242,7 +226,7 @@  ) . uncurry (-) . ( 	valuePassedPawns . Property.Opposable.getOpposite {-recent mover-} &&& valuePassedPawns  ) $ Model.Game.getNextLogicalColour game where-	valuePassedPawns :: Attribute.LogicalColour.LogicalColour -> Type.Mass.CriterionValue+	valuePassedPawns :: Colour.LogicalColour.LogicalColour -> Type.Mass.CriterionValue 	valuePassedPawns logicalColour	= Data.List.foldl' ( 		\acc -> (acc +) . recip {-value increases exponentially as distance to promotion decreases-} . fromIntegral . abs . subtract ( 			Cartesian.Ordinate.lastRank logicalColour@@ -298,19 +282,12 @@  	* Many possible criteria aren't measured because they're, either currently or imminently, represented by those that are, typically by 'measureValueOfMaterial'. -}-evaluateFitness :: (-#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).-#endif-	Fractional			pieceSquareValue,-	Real				pieceSquareValue- )-	=> Maybe pieceSquareValue	-- ^ An optional value for the specified game.+evaluateFitness+	:: Maybe Type.Mass.Base	-- ^ An optional piece-square value difference for the specified game. 	-> Model.Game.Game-	-> Input.EvaluationOptions.Reader pieceSquareValue Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues-{-# SPECIALISE evaluateFitness :: Maybe Type.Mass.PieceSquareValue -> Model.Game.Game -> Input.EvaluationOptions.Reader Type.Mass.PieceSquareValue Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues #-}-evaluateFitness maybePieceSquareValue game-	| Just gameTerminationReason <- Model.Game.getMaybeTerminationReason game	= return {-to Reader-monad-} $ Metric.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues (+	-> Input.EvaluationOptions.Reader Metric.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues+evaluateFitness maybePieceSquareValueDifference game+	| Just gameTerminationReason <- Model.Game.getMaybeTerminationReason game	= return {-to Reader-monad-} $! Metric.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues ( 		if Rule.GameTerminationReason.isCheckMate gameTerminationReason 			then 1	-- The last player to move, has won. 			else 0	-- A draw.@@ -320,14 +297,14 @@ 		rankValuePair				<- Control.Monad.Reader.asks $ Input.EvaluationOptions.getRankValues &&& Input.EvaluationOptions.getMaximumTotalRankValue 		maybePieceSquareByCoordinatesByRank	<- Control.Monad.Reader.asks Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank -		return {-to Reader-monad-} $ Input.CriteriaWeights.calculateWeightedMean criteriaWeights (+		return {-to Reader-monad-} $! Input.CriteriaWeights.calculateWeightedMean criteriaWeights ( 			uncurry measureValueOfMaterial rankValuePair game 		 ) ( 			measureValueOfMobility game 		 ) ( 			Data.Maybe.maybe 0 (-				realToFrac . (/ fromIntegral Component.Piece.nPiecesPerSide)-			) $ maybePieceSquareValue <|> fmap (`measurePieceSquareValue` game) maybePieceSquareByCoordinatesByRank+				realToFrac . (/ fromIntegral Component.Piece.nPiecesPerSide)	-- Normalise.+			) $ maybePieceSquareValueDifference <|> fmap (`measurePieceSquareValueDifference` game) maybePieceSquareByCoordinatesByRank 		 ) ( 			measureValueOfCastlingPotential game 		 ) (

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, FlexibleContexts #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -51,8 +50,8 @@ 	reduce, 	traceRoute, 	resign,-	traceMatchingMoves,-	promoteMatchingMoves,+	traceMatchingMoveSequence,+	promoteMatchingMoveSequence, 	sortNonCaptureMoves, -- ** Accessors 	getRootQuantifiedGame',@@ -83,17 +82,12 @@ import qualified	BishBosh.Property.Null				as Property.Null import qualified	BishBosh.StateProperty.Hashable			as StateProperty.Hashable import qualified	BishBosh.Type.Crypto				as Type.Crypto-import qualified	BishBosh.Type.Mass				as Type.Mass import qualified	Control.Arrow import qualified	Control.Monad.Reader import qualified	Data.Bits import qualified	Data.Maybe import qualified	Data.Tree -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- -- | Define a node in the tree to contain the hash of a /game/ & an evaluation of the fitness of that /game/. data NodeLabel positionHash	= MkNodeLabel { 	getPositionHash		:: positionHash,	-- ^ The hash of the /game/ contained in 'getQuantifiedGame'.@@ -129,7 +123,7 @@ } deriving Eq  instance Property.Arboreal.Prunable (PositionHashQuantifiedGameTree positionHash) where-	prune depth MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= MkPositionHashQuantifiedGameTree $ Property.Arboreal.prune depth barePositionHashQuantifiedGameTree+	prune depth MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= MkPositionHashQuantifiedGameTree $ Data.RoseTree.prune depth barePositionHashQuantifiedGameTree  instance Notation.MoveNotation.ShowNotationFloat (PositionHashQuantifiedGameTree positionHash) where 	showsNotationFloat moveNotation showsDouble MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree } = showString $ (@@ -144,22 +138,16 @@ fromBarePositionHashQuantifiedGameTree	= MkPositionHashQuantifiedGameTree  -- | Constructor.-mkPositionHashQuantifiedGameTree :: (-#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).-#endif-	Data.Bits.Bits			positionHash,-	Fractional			pieceSquareValue,-	Real				pieceSquareValue- )-	=> Input.EvaluationOptions.EvaluationOptions pieceSquareValue+mkPositionHashQuantifiedGameTree+	:: Data.Bits.Bits positionHash+	=> Input.EvaluationOptions.EvaluationOptions 	-> Input.SearchOptions.SearchOptions 	-> Component.Zobrist.Zobrist positionHash 	-> Model.GameTree.MoveFrequency 	-> Model.Game.Game	-- ^ The current state of the /game/. 	-> PositionHashQuantifiedGameTree positionHash {-# SPECIALISE mkPositionHashQuantifiedGameTree-	:: Input.EvaluationOptions.EvaluationOptions Type.Mass.PieceSquareValue+	:: Input.EvaluationOptions.EvaluationOptions 	-> Input.SearchOptions.SearchOptions 	-> Component.Zobrist.Zobrist Type.Crypto.PositionHash 	-> Model.GameTree.MoveFrequency@@ -169,11 +157,11 @@ mkPositionHashQuantifiedGameTree evaluationOptions searchOptions zobrist moveFrequency seedGame	= MkPositionHashQuantifiedGameTree ( 	if Input.EvaluationOptions.getIncrementalEvaluation evaluationOptions 		then let-			apexPositionHash	= StateProperty.Hashable.hash seedGame zobrist+			apexPositionHash	= StateProperty.Hashable.hash zobrist seedGame 		in Data.Tree.Node { 			Data.Tree.rootLabel	= MkNodeLabel apexPositionHash $ Control.Monad.Reader.runReader ( 				Evaluation.QuantifiedGame.fromGame Nothing seedGame-			) evaluationOptions,	-- Neither the previous positionHash nor the previous pieceSquareValue, are available to support incremental construction.+			) evaluationOptions,	-- Neither the previous positionHash nor the previous pieceSquareValueDifference, are available to support incremental construction. 			Data.Tree.subForest	= map ( 				Data.Maybe.maybe ( 					let@@ -190,33 +178,31 @@ 					in slave 				) ( 					\pieceSquareByCoordinatesByRank -> let-						slave pieceSquareValue positionHash game Data.Tree.Node {+						slave pieceSquareValueDifference positionHash game Data.Tree.Node { 							Data.Tree.rootLabel	= game', 							Data.Tree.subForest	= gameForest' 						} = Data.Tree.Node { 							Data.Tree.rootLabel	= MkNodeLabel positionHash' $ Control.Monad.Reader.runReader (-								Evaluation.QuantifiedGame.fromGame (Just pieceSquareValue') game'+								Evaluation.QuantifiedGame.fromGame (Just pieceSquareValueDifference') game' 							) evaluationOptions,-							Data.Tree.subForest	= map (slave pieceSquareValue' positionHash' game') gameForest'	-- Recurse.+							Data.Tree.subForest	= map (slave pieceSquareValueDifference' positionHash' game') gameForest'	-- Recurse. 						} where-							pieceSquareValue'	= Evaluation.Fitness.measurePieceSquareValueIncrementally pieceSquareValue pieceSquareByCoordinatesByRank game'-							positionHash'		= Model.Game.updateIncrementalPositionHash game positionHash game' zobrist-					in slave $ Evaluation.Fitness.measurePieceSquareValue pieceSquareByCoordinatesByRank seedGame+							pieceSquareValueDifference'	= Evaluation.Fitness.measurePieceSquareValueDifferenceIncrementally pieceSquareValueDifference pieceSquareByCoordinatesByRank game'+							positionHash'			= Model.Game.updateIncrementalPositionHash game positionHash game' zobrist+					in slave $ Evaluation.Fitness.measurePieceSquareValueDifference pieceSquareByCoordinatesByRank seedGame 				) ( 					Input.EvaluationOptions.getMaybePieceSquareByCoordinatesByRank evaluationOptions 				) apexPositionHash seedGame 			) $ Data.Tree.subForest bareGameTree 		}-		else fmap (-			uncurry MkNodeLabel . (-				(`StateProperty.Hashable.hash` zobrist) &&& (`Control.Monad.Reader.runReader` evaluationOptions) . Evaluation.QuantifiedGame.fromGame Nothing-			)-		) bareGameTree+		else uncurry MkNodeLabel . (+			StateProperty.Hashable.hash zobrist &&& (`Control.Monad.Reader.runReader` evaluationOptions) . Evaluation.QuantifiedGame.fromGame Nothing+		) <$> bareGameTree  ) where 	bareGameTree	= Model.GameTree.deconstruct . Model.GameTree.sortGameTree ( 		Input.SearchOptions.getMaybeCaptureMoveSortAlgorithm searchOptions 	 ) (-		`Input.RankValues.findRankValue` Input.EvaluationOptions.getRankValues evaluationOptions+		Input.RankValues.findRankValue $ Input.EvaluationOptions.getRankValues evaluationOptions 	 ) moveFrequency $ Model.GameTree.fromGame seedGame  -- | Accessor.@@ -240,7 +226,7 @@ 	:: Data.RoseTree.IsMatch (NodeLabel positionHash) 	-> PositionHashQuantifiedGameTree positionHash 	-> Maybe (PositionHashQuantifiedGameTree positionHash)-reduce isMatch MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= MkPositionHashQuantifiedGameTree `fmap` Data.RoseTree.reduce isMatch barePositionHashQuantifiedGameTree+reduce isMatch MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= MkPositionHashQuantifiedGameTree <$> Data.RoseTree.reduce isMatch barePositionHashQuantifiedGameTree  -- | Forward request. traceRoute@@ -251,11 +237,11 @@ traceRoute isMatch MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= Data.RoseTree.traceRoute isMatch barePositionHashQuantifiedGameTree  -- | Follow the specified move-sequence down the /positionHashQuantifiedGameTree/.-traceMatchingMoves+traceMatchingMoveSequence 	:: PositionHashQuantifiedGameTree positionHash-	-> [Component.QualifiedMove.QualifiedMove]+	-> Component.QualifiedMove.QualifiedMoveSequence 	-> Maybe [NodeLabel positionHash]	-- ^ Returns 'Nothing', on failure to match a move.-traceMatchingMoves MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= Data.RoseTree.traceRoute equalsLastQualifiedMove barePositionHashQuantifiedGameTree+traceMatchingMoveSequence MkPositionHashQuantifiedGameTree { deconstruct = barePositionHashQuantifiedGameTree }	= Data.RoseTree.traceRoute equalsLastQualifiedMove barePositionHashQuantifiedGameTree  -- | Amend the apex-game to reflect the resignation of the next player. resign :: PositionHashQuantifiedGameTree positionHash -> PositionHashQuantifiedGameTree positionHash@@ -277,11 +263,11 @@  	* N.B.: this can be used to dynamically re-order the forest when a transposition is detected. -}-promoteMatchingMoves-	:: [Component.QualifiedMove.QualifiedMove]	-- ^ The list of qualifiedMoves, which should be promoted at successively deeper levels in the tree.+promoteMatchingMoveSequence+	:: Component.QualifiedMove.QualifiedMoveSequence	-- ^ The list of qualifiedMoves, which should be promoted at successively deeper levels in the tree. 	-> Forest positionHash-	-> Maybe (Forest positionHash)		-- ^ Returns 'Nothing' on failure to match a move.-promoteMatchingMoves	= Data.RoseTree.promote equalsLastQualifiedMove+	-> Maybe (Forest positionHash)				-- ^ Returns 'Nothing' on failure to match a move.+promoteMatchingMoveSequence	= Data.RoseTree.promote equalsLastQualifiedMove  {- | 	* Sorts the forest, starting just after any initial capture-moves.

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, FlexibleContexts #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -40,7 +39,6 @@ -- * Constants 	unboundedInterval, -- * Functions-	compareFitness, -- ** Accessors 	getFitness, -- ** Constructors@@ -50,7 +48,10 @@ 	getLatestTurns, -- ** Mutators 	negateFitness,-	negateInterval+	negateInterval,+-- ** Predicates+	(<=>),+	(===)  ) where  import			Control.Arrow((&&&))@@ -71,10 +72,6 @@ import qualified	Data.Maybe import qualified	Data.Ord -#ifdef USE_UNBOXED_ARRAYS-import qualified	Data.Array.Unboxed-#endif- -- | The selected /game/ & the criteria against which it was quantified. data QuantifiedGame	= MkQuantifiedGame { 	getGame					:: Model.Game.Game,	-- ^ The /game/ resulting from a sequence of /turn/s.@@ -98,18 +95,28 @@ getFitness :: QuantifiedGame -> Type.Mass.WeightedMean getFitness MkQuantifiedGame { getWeightedMeanAndCriterionValues = weightedMeanAndCriterionValues }	= Metric.WeightedMeanAndCriterionValues.getWeightedMean weightedMeanAndCriterionValues +-- | Space-ship operator, like in Perl.+(<=>) :: QuantifiedGame -> QuantifiedGame -> Ordering+(<=>)	= Data.Ord.comparing getFitness++infix 4 <=>	-- Same as (>).++{- |+	* Whether the games have taken the same move-sequences, & as such have the same position.++	* CAVEAT: the games won't be identical if they started from different positions, but by some fluke managed to make the same sequence of moves.+-}+(===) :: QuantifiedGame -> QuantifiedGame -> Bool+lhs === rhs	= uncurry (==) . (($ lhs) &&& ($ rhs)) $ Model.Game.getTurnsByLogicalColour . getGame++infix 4 ===	-- Same as (==).+ -- | Constructor.-fromGame :: (-#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).-#endif-	Fractional			pieceSquareValue,-	Real				pieceSquareValue- )-	=> Maybe pieceSquareValue	-- ^ The value for the specified game.-	-> Model.Game.Game		-- ^ The current state of the /game/.-	-> Input.EvaluationOptions.Reader pieceSquareValue QuantifiedGame-fromGame maybePieceSquareValue game	= MkQuantifiedGame game `fmap` Evaluation.Fitness.evaluateFitness maybePieceSquareValue game+fromGame+	:: Maybe Type.Mass.Base	-- ^ The piece-square value difference for the specified game.+	-> Model.Game.Game	-- ^ The current state of the /game/.+	-> Input.EvaluationOptions.Reader QuantifiedGame+fromGame maybePieceSquareValueDifference game	= MkQuantifiedGame game <$> Evaluation.Fitness.evaluateFitness maybePieceSquareValueDifference game  -- | Retrieve the /turn/ used to generate the selected /game/. getLastTurn :: QuantifiedGame -> Component.Turn.Turn@@ -127,10 +134,6 @@ -- | Represent the /fitness/ of the /game/ resulting from a future /move/ by the opponent, from the perspective of the current player. negateFitness :: QuantifiedGame -> QuantifiedGame negateFitness quantifiedGame@MkQuantifiedGame { getWeightedMeanAndCriterionValues = weightedMeanAndCriterionValues }	= quantifiedGame { getWeightedMeanAndCriterionValues = Metric.WeightedMeanAndCriterionValues.negateWeightedMean weightedMeanAndCriterionValues }---- | Compares fitness.-compareFitness :: QuantifiedGame -> QuantifiedGame -> Ordering-compareFitness	= Data.Ord.comparing getFitness  {- | 	* The open interval in which to search for better solutions.

@@ -111,6 +111,7 @@ 	-> [String]	-- ^ The command-line arguments to search. 	-> [String]	-- ^ The matching argument-values. getArgs flags	= slave where+	slave :: [String] -> [String] 	slave []	= [] 	slave (x : xs) 		| x `elem` flags	= case xs of

@@ -69,6 +69,7 @@ import qualified	Control.DeepSeq import qualified	Control.Exception import qualified	Control.Monad.Reader+import qualified	Data.Array.IArray import qualified	Data.Default import qualified	Data.Foldable import qualified	Data.Maybe@@ -94,21 +95,19 @@ type IncrementalEvaluation	= Bool  -- | A pair of piece-square tables representing the opening & end-games respectively.-type PieceSquareTablePair pieceSquareValue	= (Input.PieceSquareTable.PieceSquareTable pieceSquareValue, Input.PieceSquareTable.PieceSquareTable pieceSquareValue)+type PieceSquareTablePair	= (Input.PieceSquareTable.PieceSquareTable, Input.PieceSquareTable.PieceSquareTable)  -- | Defines the options related to the automatic selection of /move/s.-data EvaluationOptions pieceSquareValue	= MkEvaluationOptions {-	getRankValues				:: Input.RankValues.RankValues,				-- ^ The static value associated with each /piece/'s /rank/.-	getMaximumTotalRankValue		:: Type.Mass.RankValue,					-- ^ Used to normalise the total value of pieces. Derived from 'getRankValues'.-	getCriteriaWeights			:: Input.CriteriaWeights.CriteriaWeights,		-- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.-	getIncrementalEvaluation		:: IncrementalEvaluation,				-- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.-	getMaybePieceSquareTablePair		:: Maybe (PieceSquareTablePair pieceSquareValue),	-- ^ A optional pair of piece-square tables representing the opening & end-games respectively.-	getMaybePieceSquareByCoordinatesByRank	:: Maybe (-		Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue-	)												-- ^ The optional value for each rank of /piece/, when occupying each coordinate, at each phase of the game.+data EvaluationOptions	= MkEvaluationOptions {+	getRankValues				:: Input.RankValues.RankValues,								-- ^ The static value associated with each /piece/'s /rank/.+	getMaximumTotalRankValue		:: Type.Mass.RankValue,									-- ^ Used to normalise the total value of pieces. Derived from 'getRankValues'.+	getCriteriaWeights			:: Input.CriteriaWeights.CriteriaWeights,						-- ^ The weights applied to each of the heterogeneous criterion-values used to select a /move/.+	getIncrementalEvaluation		:: IncrementalEvaluation,								-- ^ Whether to generate position-hashes & evaluate the piece-square value, from the previous value or from scratch.+	getMaybePieceSquareTablePair		:: Maybe PieceSquareTablePair,								-- ^ A optional pair of piece-square tables representing the opening & end-games respectively.+	getMaybePieceSquareByCoordinatesByRank	:: Maybe Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank	-- ^ The optional value for each rank of /piece/, when occupying each coordinate, at each phase of the game. } deriving (Eq, Show) -instance Control.DeepSeq.NFData pieceSquareValue => Control.DeepSeq.NFData (EvaluationOptions pieceSquareValue) where+instance Control.DeepSeq.NFData EvaluationOptions where 	rnf MkEvaluationOptions { --		getRankValues				= rankValues, 		getMaximumTotalRankValue		= maximumTotalValue,@@ -118,7 +117,7 @@ 		getMaybePieceSquareByCoordinatesByRank	= maybePieceSquareByCoordinatesByRank 	} = Control.DeepSeq.rnf (maximumTotalValue, criteriaWeights, incrementalEvaluation, maybePieceSquareByCoordinatesByRank) -instance (Real pieceSquareValue, Show pieceSquareValue) => Property.ShowFloat.ShowFloat (EvaluationOptions pieceSquareValue) where+instance Property.ShowFloat.ShowFloat EvaluationOptions where 	showsFloat fromDouble MkEvaluationOptions { 		getRankValues				= rankValues, --		getMaximumTotalRankValue		= maximumTotalValue,@@ -146,7 +145,7 @@ 		] 	 ) maybePieceSquareTablePair -instance Data.Default.Default (EvaluationOptions pieceSquareValue) where+instance Data.Default.Default EvaluationOptions where 	def = MkEvaluationOptions { 		getRankValues				= rankValues, 		getMaximumTotalRankValue		= Input.RankValues.calculateMaximumTotalValue rankValues,@@ -157,12 +156,7 @@ 	} where 		rankValues	= Data.Default.def -instance (-	Fractional	pieceSquareValue,-	Ord		pieceSquareValue,-	Real		pieceSquareValue,-	Show		pieceSquareValue- ) => HXT.XmlPickler (EvaluationOptions pieceSquareValue) where+instance HXT.XmlPickler EvaluationOptions where 	xpickle	= HXT.xpDefault def . HXT.xpElem tag . HXT.xpWrap ( 		\(a, b, c, d) -> mkEvaluationOptions a b c d,	-- Construct. 		\MkEvaluationOptions {@@ -184,27 +178,26 @@ 		def	= Data.Default.def  -- | Convert a /PieceSquareTablePair/ to a single linearly interpolated array.-fromPieceSquareTablePair :: Fractional pieceSquareValue => PieceSquareTablePair pieceSquareValue -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank pieceSquareValue+fromPieceSquareTablePair :: PieceSquareTablePair -> Component.PieceSquareByCoordinatesByRank.PieceSquareByCoordinatesByRank fromPieceSquareTablePair pieceSquareTablePair	= Component.PieceSquareByCoordinatesByRank.mkPieceSquareByCoordinatesByRank $ \rank -> (-	\(openingGamePieceSquareValuesByCoordinates, maybeEndGamePieceSquareValuesByCoordinates) -> Data.Maybe.maybe (-		Left openingGamePieceSquareValuesByCoordinates+	\(openingGamePieceSquareValueByCoordinates, maybeEndGamePieceSquareValueByCoordinates) -> Data.Maybe.maybe (+		Left openingGamePieceSquareValueByCoordinates 	) ( 		Right . Cartesian.Coordinates.listArrayByCoordinates . zipWith Component.PieceSquareByCoordinatesByRank.interpolatePieceSquareValues (-			Data.Foldable.toList openingGamePieceSquareValuesByCoordinates-		) . Data.Foldable.toList-	) maybeEndGamePieceSquareValuesByCoordinates+			Data.Array.IArray.elems openingGamePieceSquareValueByCoordinates+		) . Data.Array.IArray.elems+	) maybeEndGamePieceSquareValueByCoordinates  ) $ ( 	 Data.Maybe.fromJust {-values for the openingGame must be specified-} . Input.PieceSquareTable.dereference rank *** Input.PieceSquareTable.dereference rank  ) pieceSquareTablePair  -- | Smart constructor. mkEvaluationOptions-	:: Fractional pieceSquareValue-	=> Input.RankValues.RankValues				-- ^ The static value associated with each /piece/'s /rank/.-	-> Input.CriteriaWeights.CriteriaWeights		-- ^ The weights applied to the values of the criteria used to select a /move/.+	:: Input.RankValues.RankValues			-- ^ The static value associated with each /piece/'s /rank/.+	-> Input.CriteriaWeights.CriteriaWeights	-- ^ The weights applied to the values of the criteria used to select a /move/. 	-> IncrementalEvaluation-	-> Maybe (PieceSquareTablePair pieceSquareValue)	-- ^ The value to each type of piece, of each square, during normal play & the end-game.-	-> EvaluationOptions pieceSquareValue+	-> Maybe PieceSquareTablePair			-- ^ The value to each type of piece, of each square, during normal play & the end-game.+	-> EvaluationOptions mkEvaluationOptions rankValues criteriaWeights incrementalEvaluation maybePieceSquareTablePair 	| Just (pieceSquareTable, _)	<- maybePieceSquareTablePair 	, let undefinedRanks	= Input.PieceSquareTable.findUndefinedRanks pieceSquareTable@@ -220,10 +213,10 @@ 		getCriteriaWeights			= criteriaWeights, 		getIncrementalEvaluation		= incrementalEvaluation, 		getMaybePieceSquareTablePair		= maybePieceSquareTablePair,-		getMaybePieceSquareByCoordinatesByRank	= fromPieceSquareTablePair `fmap` maybePieceSquareTablePair	-- Infer.+		getMaybePieceSquareByCoordinatesByRank	= fromPieceSquareTablePair <$> maybePieceSquareTablePair	-- Infer. 	} where 		maximumTotalRankValue	= Input.RankValues.calculateMaximumTotalValue rankValues  -- | Self-documentation.-type Reader pieceSquareValue	= Control.Monad.Reader.Reader (EvaluationOptions pieceSquareValue)+type Reader	= Control.Monad.Reader.Reader EvaluationOptions 

@@ -46,7 +46,7 @@  import			BishBosh.Data.Bool() import			Control.Arrow((***))-import qualified	BishBosh.Attribute.ColourScheme	as Attribute.ColourScheme+import qualified	BishBosh.Colour.ColourScheme	as Colour.ColourScheme import qualified	BishBosh.Data.Exception		as Data.Exception import qualified	BishBosh.Text.ShowList		as Text.ShowList import qualified	BishBosh.Type.Length		as Type.Length@@ -84,7 +84,7 @@ -- | Constructor. data NativeUIOptions	= MkNativeUIOptions { 	getBoardMagnification	:: ScreenCoordinates,	-- ^ The factor by which the dimensions of the board are stretched when displayed.-	getColourScheme		:: Attribute.ColourScheme.ColourScheme,+	getColourScheme		:: Colour.ColourScheme.ColourScheme, 	getDepictFigurine	:: DepictFigurine	-- ^ Whether to a depict pieces using Unicode figurines. } deriving Eq @@ -109,7 +109,7 @@ 			boardMagnificationTag, 			showsPrec precision boardMagnification 		), (-			Attribute.ColourScheme.tag,+			Colour.ColourScheme.tag, 			showsPrec precision colourScheme 		), ( 			depictFigurineTag,@@ -150,7 +150,7 @@ -- | Smart constructor. mkNativeUIOptions 	:: ScreenCoordinates	-- ^ The factor by which the dimensions of the board are stretched when displayed.-	-> Attribute.ColourScheme.ColourScheme+	-> Colour.ColourScheme.ColourScheme 	-> DepictFigurine 	-> NativeUIOptions mkNativeUIOptions boardMagnification colourScheme depictFigurine

@@ -93,15 +93,15 @@ type RandomSeed	= Int  -- | Defines the application's options.-data Options pieceSquareValue	= MkOptions {-	getMaybeMaximumPlies	:: Maybe Type.Count.NPlies,					-- ^ The maximum number of plies before the game is terminated; required for profiling the application.-	getMaybeRandomSeed	:: Maybe RandomSeed,						-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.-	getEvaluationOptions	:: Input.EvaluationOptions.EvaluationOptions pieceSquareValue,	-- ^ The single set of options by which all automated /move/s are evaluated.-	getSearchOptions	:: Input.SearchOptions.SearchOptions,				-- ^ The options by which to automatically select /move/s.-	getIOOptions		:: Input.IOOptions.IOOptions					-- ^ The /ioOptions/ by which to receive commands & present results.+data Options	= MkOptions {+	getMaybeMaximumPlies	:: Maybe Type.Count.NPlies,			-- ^ The maximum number of plies before the game is terminated; required for profiling the application.+	getMaybeRandomSeed	:: Maybe RandomSeed,				-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.+	getEvaluationOptions	:: Input.EvaluationOptions.EvaluationOptions,	-- ^ The single set of options by which all automated /move/s are evaluated.+	getSearchOptions	:: Input.SearchOptions.SearchOptions,		-- ^ The options by which to automatically select /move/s.+	getIOOptions		:: Input.IOOptions.IOOptions			-- ^ The /ioOptions/ by which to receive commands & present results. } deriving (Eq, Show) -instance Control.DeepSeq.NFData pieceSquareValue => Control.DeepSeq.NFData (Options pieceSquareValue) where+instance Control.DeepSeq.NFData Options where 	rnf MkOptions { 		getMaybeMaximumPlies	= maybeMaximumPlies, 		getMaybeRandomSeed	= maybeRandomSeed,@@ -110,7 +110,7 @@ 		getIOOptions		= ioOptions 	} = Control.DeepSeq.rnf (maybeMaximumPlies, maybeRandomSeed, evaluationOptions, searchOptions, ioOptions) -instance (Real pieceSquareValue, Show pieceSquareValue) => Property.ShowFloat.ShowFloat (Options pieceSquareValue) where+instance Property.ShowFloat.ShowFloat Options where 	showsFloat fromDouble MkOptions { 		getMaybeMaximumPlies	= maybeMaximumPlies, 		getMaybeRandomSeed	= maybeRandomSeed,@@ -134,7 +134,7 @@ 		) 	 ] -instance Data.Default.Default (Options pieceSquareValue) where+instance Data.Default.Default Options where 	def = MkOptions { 		getMaybeMaximumPlies	= Nothing, 		getMaybeRandomSeed	= Nothing,@@ -143,12 +143,7 @@ 		getIOOptions		= Data.Default.def 	} -instance (-	Fractional	pieceSquareValue,-	Ord		pieceSquareValue,-	Real		pieceSquareValue,-	Show		pieceSquareValue- ) => HXT.XmlPickler (Options pieceSquareValue) where+instance HXT.XmlPickler Options where 	xpickle	= HXT.xpElem tag . HXT.xpWrap ( 		\(a, b, c, d, e) -> mkOptions a b c d e,	-- Construct. 		\MkOptions {@@ -174,10 +169,10 @@ mkOptions 	:: Maybe Type.Count.NPlies	-- ^ The maximum number of plies before the game is terminated; required for profiling the application. 	-> Maybe RandomSeed		-- ^ Optionally seed the pseudo-random number-generator to produce a repeatable sequence.-	-> Input.EvaluationOptions.EvaluationOptions pieceSquareValue+	-> Input.EvaluationOptions.EvaluationOptions 	-> Input.SearchOptions.SearchOptions 	-> Input.IOOptions.IOOptions-	-> Options pieceSquareValue+	-> Options mkOptions maybeMaximumPlies maybeRandomSeed evaluationOptions searchOptions ioOptions 	| Just maximumPlies	<- maybeMaximumPlies 	, maximumPlies <= 0	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.Options.mkOptions:\t" . showString maximumPliesTag . Text.ShowList.showsAssociation $ shows maximumPlies " must exceed zero."@@ -193,22 +188,22 @@ 	}  -- | The type of a function used to transform 'Options'.-type Transformation pieceSquareValue	= Options pieceSquareValue -> Options pieceSquareValue+type Transformation	= Options -> Options  -- | Mutator.-setMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath -> Transformation pieceSquareValue+setMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath -> Transformation setMaybeOutputConfigFilePath maybeOutputConfigFilePath options@MkOptions { getIOOptions	= ioOptions }	= options { 	getIOOptions	= Input.IOOptions.setMaybeOutputConfigFilePath maybeOutputConfigFilePath ioOptions }  -- | Mutator.-setMaybeRandomSeed :: Maybe RandomSeed -> Transformation pieceSquareValue+setMaybeRandomSeed :: Maybe RandomSeed -> Transformation setMaybeRandomSeed maybeRandomSeed options	= options { 	getMaybeRandomSeed	= maybeRandomSeed }  -- | Mutator.-setMaybePersistence :: Maybe (System.FilePath.FilePath, Bool) -> Transformation pieceSquareValue+setMaybePersistence :: Maybe (System.FilePath.FilePath, Bool) -> Transformation setMaybePersistence maybePersistence options@MkOptions { getIOOptions = ioOptions }	= options { 	getIOOptions	= ioOptions { 		Input.IOOptions.getMaybePersistence	= maybePersistence@@ -216,25 +211,25 @@ }  -- | Mutator.-setVerbosity :: Input.Verbosity.Verbosity -> Transformation pieceSquareValue+setVerbosity :: Input.Verbosity.Verbosity -> Transformation setVerbosity verbosity options@MkOptions { getIOOptions = ioOptions }	= options { 	getIOOptions	= Input.IOOptions.setVerbosity verbosity ioOptions }  -- | Mutator.-setEitherNativeUIOrCECPOptions :: Input.UIOptions.EitherNativeUIOrCECPOptions -> Transformation pieceSquareValue+setEitherNativeUIOrCECPOptions :: Input.UIOptions.EitherNativeUIOrCECPOptions -> Transformation setEitherNativeUIOrCECPOptions eitherNativeUIOrCECPOptions options@MkOptions { getIOOptions = ioOptions }	= options { 	getIOOptions	= Input.IOOptions.setEitherNativeUIOrCECPOptions eitherNativeUIOrCECPOptions ioOptions }  -- | Mutator.-setMaybePrintMoveTree :: Maybe Property.Arboreal.Depth -> Transformation pieceSquareValue+setMaybePrintMoveTree :: Maybe Property.Arboreal.Depth -> Transformation setMaybePrintMoveTree maybePrintMoveTree options@MkOptions { getIOOptions = ioOptions }	= options { 	getIOOptions	= Input.IOOptions.setMaybePrintMoveTree maybePrintMoveTree ioOptions }  -- | Mutator.-swapSearchDepth :: Transformation pieceSquareValue+swapSearchDepth :: Transformation swapSearchDepth options@MkOptions { getSearchOptions = searchOptions }	= options { 	getSearchOptions	= Input.SearchOptions.swapSearchDepth searchOptions }

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {- 	Copyright (C) 2018 Dr. Alistair Ward @@ -40,6 +41,7 @@ -- ** Type-synonyms --	Normalise, --	ReflectOnY,+--	PieceSquareValueByCoordinates, 	IOFormat, 	Assocs, -- ** Data-types@@ -61,7 +63,7 @@ -- ** Constructors 	mkPieceSquareTable, -- ** Predicates-	inClosedUnitInterval+--	inClosedUnitInterval ) where  import			BishBosh.Data.Bool()	-- HXT.XmlPickler.@@ -77,10 +79,11 @@ import qualified	BishBosh.Property.ShowFloat		as Property.ShowFloat import qualified	BishBosh.Text.Case			as Text.Case import qualified	BishBosh.Text.ShowList			as Text.ShowList+import qualified	BishBosh.Type.Mass			as Type.Mass import qualified	Control.Arrow import qualified	Control.Exception+import qualified	Data.Array.IArray import qualified	Data.Default-import qualified	Data.Foldable import qualified	Data.Map.Strict				as Map import qualified	Data.Set import qualified	Text.XML.HXT.Arrow.Pickle		as HXT@@ -103,20 +106,27 @@ -- | Type-synonym. type ReflectOnY	= Bool +-- | Self-documentation.+type PieceSquareValueByCoordinates	=+#if defined(USE_UNBOXED_ARRAYS) && !(defined(USE_NEWTYPE_WRAPPERS) || defined(USE_PRECISION))+	Cartesian.Coordinates.UArrayByCoordinates+#else+	Cartesian.Coordinates.ArrayByCoordinates+#endif+		Type.Mass.PieceSquareValue+ -- | Defines the value for each type of piece, of occupying each square.-data PieceSquareTable pieceSquareValue	= MkPieceSquareTable {-	getNormalise				:: Normalise,	-- ^ Whether to map the specified values into the closed unit-interval.	CAVEAT: incompatible with RelaxNG, the specification for which already constrains values to the unit-interval.-	getReflectOnY				:: ReflectOnY,	-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.-	getPieceSquareValueByCoordinatesByRank	:: Map.Map Attribute.Rank.Rank (-		Cartesian.Coordinates.ArrayByCoordinates pieceSquareValue-	)							-- ^ N.B.: on the assumption that the values for Black pieces are the reflection of those for White, merely the /rank/ of each /piece/ need be defined.+data PieceSquareTable	= MkPieceSquareTable {+	getNormalise				:: Normalise,							-- ^ Whether to map the specified values into the closed unit-interval.	CAVEAT: incompatible with RelaxNG, the specification for which already constrains values to the unit-interval.+	getReflectOnY				:: ReflectOnY,							-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.+	getPieceSquareValueByCoordinatesByRank	:: Map.Map Attribute.Rank.Rank PieceSquareValueByCoordinates	-- ^ N.B.: on the assumption that the values for Black pieces are the reflection of those for White, merely the /rank/ of each /piece/ need be defined. } deriving (Eq, Show) -instance (Real pieceSquareValue, Show pieceSquareValue) => Property.ShowFloat.ShowFloat (PieceSquareTable pieceSquareValue) where+instance Property.ShowFloat.ShowFloat PieceSquareTable where 	showsFloat fromDouble MkPieceSquareTable { 		getNormalise				= normalise, 		getReflectOnY				= reflectOnY,-		getPieceSquareValueByCoordinatesByRank	= byRank+		getPieceSquareValueByCoordinatesByRank	= pieceSquareValueByCoordinatesByRank 	} = Text.ShowList.showsAssociationList Text.ShowList.showsSeparator $ ( 		normaliseTag, 		shows normalise@@ -130,12 +140,12 @@ 			if reflectOnY 				then unmirror 				else id-		) . Data.Foldable.toList+		) . Data.Array.IArray.elems 	 ) (-		Map.toList byRank+		Map.toList pieceSquareValueByCoordinatesByRank 	 ) -instance Data.Default.Default (PieceSquareTable pieceSquareValue) where+instance Data.Default.Default PieceSquareTable where 	def = MkPieceSquareTable { 		getNormalise				= False, 		getReflectOnY				= True,@@ -145,28 +155,23 @@ -- | The format of the values when read or written. type IOFormat	= Double -instance (-	Fractional	pieceSquareValue,-	Ord		pieceSquareValue,-	Real		pieceSquareValue,-	Show		pieceSquareValue- ) => HXT.XmlPickler (PieceSquareTable pieceSquareValue) where+instance HXT.XmlPickler PieceSquareTable where 	xpickle	= HXT.xpWrap ( 		\(a, b, c)	-> mkPieceSquareTable a b c,	-- Construct. 		\MkPieceSquareTable { 			getNormalise				= normalise, 			getReflectOnY				= reflectOnY,-			getPieceSquareValueByCoordinatesByRank	= byRank+			getPieceSquareValueByCoordinatesByRank	= pieceSquareValueByCoordinatesByRank 		} -> ( 			normalise, 			reflectOnY, 			Map.toList $ Map.map (-				(+				map realToFrac . ( 					if reflectOnY 						then unmirror 						else id-				) . Data.Foldable.toList-			) byRank+				) . Data.Array.IArray.elems+			) pieceSquareValueByCoordinatesByRank 		) -- Deconstruct to tuple. 	 ) . HXT.xpTriple ( 		getNormalise Data.Default.def `HXT.xpDefault` HXT.xpAttr normaliseTag HXT.xpickle {-Bool-}@@ -177,11 +182,13 @@ 			showString "by" $ Text.Case.toUpperInitial Attribute.Rank.tag 		) $ HXT.xpickle {-rank-} `HXT.xpPair` HXT.xpWrap ( 			\s -> [-				realToFrac (pieceSquareValue :: IOFormat) |+				(realToFrac :: IOFormat -> Type.Mass.Base) pieceSquareValue | 					word			<- words s, 					(pieceSquareValue, "")	<- reads word 			], -- List-comprehension.-			unwords . map (show . (\pieceSquareValue -> realToFrac pieceSquareValue :: IOFormat))+			unwords . map (+				show . (realToFrac :: Type.Mass.Base -> IOFormat)+			) -- Deconstruct. 		) ( 			HXT.xpTextAttr . showString "by" $ Text.Case.toUpperInitial Cartesian.Coordinates.tag 		)@@ -191,26 +198,20 @@ type Assocs rank pieceSquareValue	= [(rank, [pieceSquareValue])]  -- | Map the range of values onto the Closed Unit Interval.-normaliseToUnitInterval-	:: (Fractional pieceSquareValue, Ord pieceSquareValue)-	=> Assocs rank pieceSquareValue-	-> Assocs rank pieceSquareValue+normaliseToUnitInterval :: (Fractional pieceSquareValueIn, Real pieceSquareValueIn, Fractional pieceSquareValueOut) => Assocs rank pieceSquareValueIn -> Assocs rank pieceSquareValueOut normaliseToUnitInterval []	= [] normaliseToUnitInterval assocs 	| range == 0	= Control.Exception.throw $ Data.Exception.mkNullDatum "BishBosh.Input.PieceSquareTable.normaliseToUnitInterval:\tthe specified piece-square values are identical." 	| otherwise	= map (-		Control.Arrow.second $ map ((/ range) . subtract minimum')+		Control.Arrow.second $ map (realToFrac . (/ range) . subtract minimum') 	) assocs 	where 		bounds@(minimum', _)	= minimum &&& maximum $ concatMap snd assocs	-- Analyse the range of values. 		range			= uncurry subtract bounds  -- | Check that the range of values is in the Closed Unit Interval.-inClosedUnitInterval-	:: (Num pieceSquareValue, Ord pieceSquareValue)-	=> Assocs rank pieceSquareValue-	-> Bool-inClosedUnitInterval	= all $ all Data.Num.inClosedUnitInterval . snd {-[pieceSquareValue]-}+inClosedUnitInterval :: (Num pieceSquareValue, Ord pieceSquareValue) => Assocs rank pieceSquareValue -> Bool+inClosedUnitInterval	= all $ all Data.Num.inClosedUnitInterval . snd {-[PieceSquareValue]-}  -- | Generates a mirror-symmetric RHS, to build a complete description. mirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]@@ -225,18 +226,14 @@ unmirror pieceSquareValues		= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Input.PieceSquareTable.unmirror:\tthe number of piece-square values must be a multiple of " . shows (Cartesian.Abscissa.xLength `div` 2) . showString "; " $ shows pieceSquareValues "."  -- | Smart constructor.-mkPieceSquareTable :: (-	Fractional	pieceSquareValue,-	Ord		pieceSquareValue,-	Show		pieceSquareValue- )-	=> Normalise	-- ^ Whether to normalise the specified values into the closed unit interval.+mkPieceSquareTable+	:: Normalise	-- ^ Whether to normalise the specified values into the closed unit interval. 	-> ReflectOnY	-- ^ Whether values for the RHS of the board are inferred by reflection about the y-axis.-	-> Assocs Attribute.Rank.Rank pieceSquareValue-	-> PieceSquareTable pieceSquareValue+	-> Assocs Attribute.Rank.Rank Type.Mass.Base+	-> PieceSquareTable mkPieceSquareTable normalise reflectOnY assocs 	| any (-		(/= nValuesRequired) . fromIntegral . length . snd {-pieceSquareValues-}+		(/= nValuesRequired) . fromIntegral . length . snd {-PieceSquareValues-} 	) assocs						= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\texactly " . shows nValuesRequired . showString " values must be defined for each type of piece; " $ shows assocs "." 	| not $ null duplicateRanks				= Control.Exception.throw . Data.Exception.mkDuplicateData . showString "BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\tranks must be distinct; " $ shows duplicateRanks "." 	| not $ normalise || inClosedUnitInterval assocs	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\tall values must be within the closed unit-interval [0,1]; " $ shows assocs "."@@ -252,7 +249,7 @@ 		) $ ( 			if normalise 				then normaliseToUnitInterval-				else id+				else map (Control.Arrow.second $ map realToFrac) 		) assocs 	} 	where@@ -265,13 +262,10 @@ 		 ) Cartesian.Coordinates.nSquares  -- | Identify any /rank/ lacking a definition.-findUndefinedRanks :: PieceSquareTable pieceSquareValue -> Data.Set.Set Attribute.Rank.Rank+findUndefinedRanks :: PieceSquareTable -> Data.Set.Set Attribute.Rank.Rank findUndefinedRanks MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank = pieceSquareValueByCoordinatesByRank }	= Data.Set.fromAscList Property.FixedMembership.members `Data.Set.difference` Map.keysSet pieceSquareValueByCoordinatesByRank  -- | Lookup the values for all /coordinates/, corresponding to the specified /rank/.-dereference-	:: Attribute.Rank.Rank-	-> PieceSquareTable pieceSquareValue-	-> Maybe (Cartesian.Coordinates.ArrayByCoordinates pieceSquareValue)+dereference :: Attribute.Rank.Rank -> PieceSquareTable -> Maybe PieceSquareValueByCoordinates dereference rank MkPieceSquareTable { getPieceSquareValueByCoordinatesByRank = pieceSquareValueByCoordinatesByRank }	= Map.lookup rank pieceSquareValueByCoordinatesByRank 

@@ -116,8 +116,8 @@ 		byRank					= Attribute.Rank.arrayByRank assocs  -- | Query.-findRankValue :: Attribute.Rank.Rank -> RankValues -> Metric.RankValue.RankValue-findRankValue rank (MkRankValues byRank)	= byRank ! rank+findRankValue :: RankValues -> Attribute.Rank.Rank -> Metric.RankValue.RankValue+findRankValue (MkRankValues byRank)	= (byRank !)  {- | 	* The maximum total rank-value one side can have.

@@ -81,7 +81,7 @@ import			BishBosh.Data.Bool()		-- For 'HXT.xpickle'. import			Control.Arrow((***)) import qualified	BishBosh.Attribute.CaptureMoveSortAlgorithm	as Attribute.CaptureMoveSortAlgorithm-import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour+import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour import qualified	BishBosh.Data.Exception				as Data.Exception import qualified	BishBosh.Data.Foldable import qualified	BishBosh.Input.StandardOpeningOptions		as Input.StandardOpeningOptions@@ -137,7 +137,7 @@  -- | Used to qualify XML. searchDepthByLogicalColourTag :: String-searchDepthByLogicalColourTag		= showString searchDepthTag . showString "By" $ Text.Case.toUpperInitial Attribute.LogicalColour.tag+searchDepthByLogicalColourTag		= showString searchDepthTag . showString "By" $ Text.Case.toUpperInitial Colour.LogicalColour.tag  -- | The constant minimum permissible search-depth. minimumSearchDepth :: Type.Count.NPlies@@ -170,7 +170,7 @@ type MaybeUseTranspositions		= Maybe (Type.Count.NMoves, Type.Count.NPlies)  -- | The depth to search for each /logical colour/.-type SearchDepthByLogicalColour		= Map.Map Attribute.LogicalColour.LogicalColour Type.Count.NPlies+type SearchDepthByLogicalColour		= Map.Map Colour.LogicalColour.LogicalColour Type.Count.NPlies  -- | Defines options related to searching for a move. data SearchOptions	= MkSearchOptions {@@ -308,11 +308,11 @@ 					duplicateLogicalColours	= BishBosh.Data.Foldable.findDuplicates $ map fst {-logicalColour-} l 				in if null duplicateLogicalColours 					then l-					else Control.Exception.throw . Data.Exception.mkDuplicateData . showString "BishBosh.Input.SearchOptions.xpickle:\t" . showString Attribute.LogicalColour.tag . showString "s must be distinct; " $ shows duplicateLogicalColours "."+					else Control.Exception.throw . Data.Exception.mkDuplicateData . showString "BishBosh.Input.SearchOptions.xpickle:\t" . showString Colour.LogicalColour.tag . showString "s must be distinct; " $ shows duplicateLogicalColours "." 			),	-- Construct from a List. 			Map.toList		-- Deconstruct to an association-list. 		) . HXT.xpList {-potentially null-} . HXT.xpElem (-			showString "by" $ Text.Case.toUpperInitial Attribute.LogicalColour.tag+			showString "by" $ Text.Case.toUpperInitial Colour.LogicalColour.tag 		) $ HXT.xpickle {-LogicalColour-} `HXT.xpPair` HXT.xpAttr searchDepthTag HXT.xpickle {-NPlies-} 	 ) where 		def	= Data.Default.def@@ -330,14 +330,14 @@ 	-> SearchDepthByLogicalColour 	-> SearchOptions mkSearchOptions sortOnStandardOpeningMoveFrequency maybeCaptureMoveSortAlgorithm maybeMinimumHammingDistance maybeRetireKillerMovesAfter trapRepeatedPositions usePondering maybeUseTranspositions standardOpeningOptions searchDepthByLogicalColour-	| Just minimumHammingDistance		<- maybeMinimumHammingDistance+	| Just minimumHammingDistance			<- maybeMinimumHammingDistance 	, minimumHammingDistance < 1	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.SearchOptions.mkSearchOptions:\t" . showString minimumHammingDistanceTag . Text.ShowList.showsAssociation $ shows minimumHammingDistance " must exceed zero."-	| Just retireKillerMovesAfter		<- maybeRetireKillerMovesAfter+	| Just retireKillerMovesAfter			<- maybeRetireKillerMovesAfter 	, retireKillerMovesAfter < 0	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.SearchOptions.mkSearchOptions:\t" . showString retireKillerMovesAfterTag . Text.ShowList.showsAssociation $ shows retireKillerMovesAfter " can't be negative." 	| let nAutomatedPlayers	= Data.Foldable.length searchDepthByLogicalColour 	, usePondering && nAutomatedPlayers /= 1 	= Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.SearchOptions.mkSearchOptions:\tpondering is pointless unless there's an automated player who can use the unused CPU-time during a manual player's move, but there're " $ shows nAutomatedPlayers " automated players."-	| Just (retireTranspositionsAfter, _)	<- maybeUseTranspositions+	| Just (retireTranspositionsAfter, _)		<- maybeUseTranspositions 	, retireTranspositionsAfter < 0	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.SearchOptions.mkSearchOptions:\t" . showString retireTranspositionsAfterTag . Text.ShowList.showsAssociation $ shows retireTranspositionsAfter " can't be negative." 	| Just (_, minimumTranspositionSearchDepth)	<- maybeUseTranspositions 	, minimumTranspositionSearchDepth < 1	= Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.SearchOptions.mkSearchOptions:\t" . showString minimumTranspositionSearchDepthTag . Text.ShowList.showsAssociation $ shows minimumTranspositionSearchDepth " must exceed zero."@@ -398,7 +398,7 @@ }  -- | Extract those /logical colour/s for which a search-depth has been defined, which implies that the corresponding player is automated.-identifyAutomatedPlayers :: SearchOptions -> [Attribute.LogicalColour.LogicalColour]+identifyAutomatedPlayers :: SearchOptions -> [Colour.LogicalColour.LogicalColour] identifyAutomatedPlayers MkSearchOptions { 	getSearchDepthByLogicalColour	= searchDepthByLogicalColour } = Map.keys searchDepthByLogicalColour

@@ -213,12 +213,12 @@ -- | Mutator. updateCECPFeature :: Input.CECPFeatures.Feature -> Transformation updateCECPFeature feature uiOptions@MkUIOptions { getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions }	= uiOptions {-	getEitherNativeUIOrCECPOptions	= Input.CECPOptions.updateFeature feature `fmap` eitherNativeUIOrCECPOptions+	getEitherNativeUIOrCECPOptions	= Input.CECPOptions.updateFeature feature <$> eitherNativeUIOrCECPOptions }  -- | Mutator. deleteCECPFeature :: Input.CECPFeatures.Feature -> Transformation deleteCECPFeature feature uiOptions@MkUIOptions { getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions }	= uiOptions {-	getEitherNativeUIOrCECPOptions	= Input.CECPOptions.deleteFeature feature `fmap` eitherNativeUIOrCECPOptions+	getEitherNativeUIOrCECPOptions	= Input.CECPOptions.deleteFeature feature <$> eitherNativeUIOrCECPOptions } 

@@ -53,15 +53,15 @@ 	showsPrec precedence (MkCriterionValue criterionValue)	= showsPrec precedence criterionValue  instance Num CriterionValue where-	MkCriterionValue l + MkCriterionValue r		= mkCriterionValue $ l + r-	MkCriterionValue l * MkCriterionValue r		= MkCriterionValue $ l * r-	abs (MkCriterionValue criterionValue)		= MkCriterionValue $ abs criterionValue-	signum (MkCriterionValue criterionValue)	= MkCriterionValue $ signum criterionValue+	MkCriterionValue l + MkCriterionValue r		= mkCriterionValue $! l + r+	MkCriterionValue l * MkCriterionValue r		= MkCriterionValue $! l * r+	abs (MkCriterionValue criterionValue)		= MkCriterionValue $! abs criterionValue+	signum (MkCriterionValue criterionValue)	= MkCriterionValue $! signum criterionValue 	fromInteger					= mkCriterionValue . fromInteger-	negate (MkCriterionValue criterionValue)	= MkCriterionValue $ negate criterionValue+	negate (MkCriterionValue criterionValue)	= MkCriterionValue $! negate criterionValue  instance Fractional CriterionValue where-	MkCriterionValue l / MkCriterionValue r	= mkCriterionValue $ l / r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid.+	MkCriterionValue l / MkCriterionValue r	= mkCriterionValue $! l / r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid. 	fromRational				= mkCriterionValue . fromRational  instance Real CriterionValue where

@@ -61,15 +61,15 @@ 	showsPrec precedence (MkCriterionWeight criterionWeight)	= showsPrec precedence criterionWeight  instance Num CriterionWeight where-	MkCriterionWeight l + MkCriterionWeight r	= mkCriterionWeight $ l + r-	MkCriterionWeight l * MkCriterionWeight r	= MkCriterionWeight $ l * r-	abs (MkCriterionWeight criterionWeight)		= MkCriterionWeight $ abs criterionWeight	-- N.B.: if the operand is valid, then this is equivalent to 'id'.-	signum (MkCriterionWeight criterionWeight)	= MkCriterionWeight $ signum criterionWeight+	MkCriterionWeight l + MkCriterionWeight r	= mkCriterionWeight $! l + r+	MkCriterionWeight l * MkCriterionWeight r	= MkCriterionWeight $! l * r+	abs (MkCriterionWeight criterionWeight)		= MkCriterionWeight $! abs criterionWeight	-- N.B.: if the operand is valid, then this is equivalent to 'id'.+	signum (MkCriterionWeight criterionWeight)	= MkCriterionWeight $! signum criterionWeight 	fromInteger					= mkCriterionWeight . fromInteger-	negate (MkCriterionWeight criterionWeight)	= mkCriterionWeight $ negate criterionWeight	-- CAVEAT: only valid for '0'.+	negate (MkCriterionWeight criterionWeight)	= mkCriterionWeight $! negate criterionWeight	-- CAVEAT: only valid for '0'.  instance Fractional CriterionWeight where-	MkCriterionWeight l / MkCriterionWeight r	= mkCriterionWeight $ l / r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid.+	MkCriterionWeight l / MkCriterionWeight r	= mkCriterionWeight $! l / r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid. 	fromRational					= mkCriterionWeight . fromRational  instance Real CriterionWeight where

@@ -66,18 +66,18 @@ 	readsPrec precision	= map (Control.Arrow.first mkRankValue) . readsPrec precision . Data.List.Extra.trimStart  instance Property.ShowFloat.ShowFloat RankValue where-	showsFloat fromDouble MkRankValue { deconstruct = rankValue }	= fromDouble $ realToFrac rankValue+	showsFloat fromDouble MkRankValue { deconstruct = rankValue }	= fromDouble $! realToFrac rankValue  instance Num RankValue where-	MkRankValue { deconstruct = l } + MkRankValue { deconstruct = r }	= mkRankValue $ l + r-	MkRankValue { deconstruct = l } * MkRankValue { deconstruct = r }	= MkRankValue $ l * r-	abs MkRankValue { deconstruct = rankValue }				= MkRankValue $ abs rankValue		-- N.B.: if the operand is valid, then this is equivalent to 'id'.-	signum MkRankValue { deconstruct = rankValue }				= MkRankValue $ signum rankValue+	MkRankValue { deconstruct = l } + MkRankValue { deconstruct = r }	= mkRankValue $! l + r+	MkRankValue { deconstruct = l } * MkRankValue { deconstruct = r }	= MkRankValue $! l * r+	abs MkRankValue { deconstruct = rankValue }				= MkRankValue $! abs rankValue		-- N.B.: if the operand is valid, then this is equivalent to 'id'.+	signum MkRankValue { deconstruct = rankValue }				= MkRankValue $! signum rankValue 	fromInteger								= mkRankValue . fromInteger-	negate MkRankValue { deconstruct = rankValue }				= mkRankValue $ negate rankValue	-- CAVEAT: only valid for '0'.+	negate MkRankValue { deconstruct = rankValue }				= mkRankValue $! negate rankValue	-- CAVEAT: only valid for '0'.  instance Fractional RankValue where-	MkRankValue { deconstruct = l } / MkRankValue { deconstruct = r }	= mkRankValue $ l / r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid.+	MkRankValue { deconstruct = l } / MkRankValue { deconstruct = r }	= mkRankValue $! l / r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid. 	fromRational								= mkRankValue . fromRational  instance Real RankValue where@@ -87,7 +87,7 @@ 	rnf MkRankValue { deconstruct = rankValue }	= Control.DeepSeq.rnf rankValue  instance HXT.XmlPickler RankValue where-	xpickle	= HXT.xpWrap (mkRankValue, deconstruct) $ HXT.xpAttr tag HXT.xpickle+	xpickle	= HXT.xpWrap (mkRankValue, deconstruct) $! HXT.xpAttr tag HXT.xpickle  -- | Smart constructor. mkRankValue :: Type.Mass.RankValue -> RankValue

@@ -76,7 +76,7 @@ 		getWeightedMean		= weightedMean, 		getCriterionValues	= criterionValues 	} = Text.ShowList.showsAssociationList' [-		(weightedMeanTag, fromDouble $ realToFrac weightedMean),+		(weightedMeanTag, fromDouble $! realToFrac weightedMean), 		(criterionValuesTag, Text.ShowList.showsFormattedList' (fromDouble . realToFrac) criterionValues) 	 ] 

@@ -88,12 +88,12 @@ ) where  import			Control.Arrow((&&&), (***), (|||))-import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour import qualified	BishBosh.Attribute.MoveType			as Attribute.MoveType 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.Vector			as Cartesian.Vector+import qualified	BishBosh.Colour.LogicalColour			as Colour.LogicalColour import qualified	BishBosh.Component.CastlingMove			as Component.CastlingMove import qualified	BishBosh.Component.EitherQualifiedMove		as Component.EitherQualifiedMove import qualified	BishBosh.Component.Move				as Component.Move@@ -172,7 +172,7 @@ sortAvailableQualifiedMoves	= Map.map . Data.List.sortBy $ Data.Ord.comparing fst {-destination-}  -- | The /move/s available to both players.-type AvailableQualifiedMovesByLogicalColour	= Map.Map Attribute.LogicalColour.LogicalColour AvailableQualifiedMoves+type AvailableQualifiedMovesByLogicalColour	= Map.Map Colour.LogicalColour.LogicalColour AvailableQualifiedMoves  {- | 	* The first three fields represent the state of the /game/.@@ -182,11 +182,11 @@ 	* For efficiency the list of available /move/s is stored. -} data Game	= MkGame {-	getNextLogicalColour				:: Attribute.LogicalColour.LogicalColour,				-- ^ N.B.: can be derived from 'getTurnsByLogicalColour', unless 'Property.Reflectable.reflectOnX' has been called.+	getNextLogicalColour				:: Colour.LogicalColour.LogicalColour,					-- ^ N.B.: can be derived from 'getTurnsByLogicalColour', unless 'Property.Reflectable.reflectOnX' has been called. 	getCastleableRooksByLogicalColour		:: State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour,	-- ^ Those @Rook@s which can still participate in castling. 	getBoard					:: State.Board.Board,							-- ^ The current state of the /board/. 	getTurnsByLogicalColour				:: State.CastleableRooksByLogicalColour.TurnsByLogicalColour,		-- ^ Successive /move/s & any /piece/ taken, recorded by player.-	getMaybeChecked					:: Maybe Attribute.LogicalColour.LogicalColour,				-- ^ The player (if any), whose currently /checked/; which will typically be 'getNextLogicalColour', but 'listQualifiedMovesAvailableTo' can be called for either player.+	getMaybeChecked					:: Maybe Colour.LogicalColour.LogicalColour,				-- ^ The player (if any), whose currently /checked/; which will typically be 'getNextLogicalColour', but 'listQualifiedMovesAvailableTo' can be called for either player. 	getInstancesByPosition				:: InstancesByPosition,							-- ^ The number of instances of various positions since the last unrepeatable move. 	getAvailableQualifiedMovesByLogicalColour	:: AvailableQualifiedMovesByLogicalColour,				-- ^ The /move/s available to each player. Since this is merely required for efficiency, it needn't have an entry for both players; & typically doesn't when checked, since radical pruning would otherwise be required. CAVEAT: doesn't account for game-termination. 	getMaybeTerminationReason			:: Maybe Rule.GameTerminationReason.GameTerminationReason		-- ^ The reason (where appropriate) why the game was terminated.@@ -283,11 +283,11 @@  instance Data.Default.Default Game where 	def = (-		mkGame Attribute.LogicalColour.White Data.Default.def {-castleableRooksByLogicalColour-} Data.Default.def {-board-} Data.Default.def {-turnsByLogicalColour-}+		mkGame Colour.LogicalColour.White Data.Default.def {-castleableRooksByLogicalColour-} Data.Default.def {-board-} Data.Default.def {-turnsByLogicalColour-} 	 ) { 		getMaybeChecked					= Nothing, 		getAvailableQualifiedMovesByLogicalColour	= Map.fromAscList $ map (-			id &&& (`mkAvailableQualifiedMovesFor` Data.Default.def {-game-})+			id &&& mkAvailableQualifiedMovesFor Data.Default.def {-game-} 		) Property.FixedMembership.members 	} @@ -335,7 +335,7 @@ 		Property.ExtendedPositionDescription.showsEPD nextLogicalColour,		-- 2. Active colour. 		Property.ExtendedPositionDescription.showsEPD castleableRooksByLogicalColour,	-- 3. Castling availability. 		Data.Maybe.maybe Property.ExtendedPositionDescription.showsNullField (-			\turn -> if Component.Turn.isPawnDoubleAdvance (Property.Opposable.getOpposite nextLogicalColour) turn+			\turn -> if Component.Turn.isPawnDoubleAdvance turn $ Property.Opposable.getOpposite nextLogicalColour 				then Notation.MoveNotation.showsNotation Data.Default.def {-Smith is the same as the required Algebraic notation in this limited role-} . Cartesian.Coordinates.advance nextLogicalColour . Component.Move.getDestination . Component.QualifiedMove.getMove $ Component.Turn.getQualifiedMove turn 				else Property.ExtendedPositionDescription.showsNullField 		) $ maybeLastTurn game	-- 4. En-passant target square. CAVEAT: in contrast to X-EPD, this is required even when there's no opposing Pawn in a suitable position to take en-passant.@@ -357,7 +357,7 @@ 	 } = Text.ShowList.showsDelimitedList Property.ExtendedPositionDescription.showsSeparator id id [ 		Property.ExtendedPositionDescription.showsEPD game, 		shows $ State.InstancesByPosition.countConsecutiveRepeatablePlies instancesByPosition, -- 5. Half move clock.-		shows . succ {-the full-move counter starts at '1', before any move has occurred-} . length $ State.TurnsByLogicalColour.dereference Attribute.LogicalColour.Black turnsByLogicalColour	-- 6. Full move counter.+		shows . succ {-the full-move counter starts at '1', before any move has occurred-} . length $ State.TurnsByLogicalColour.dereference turnsByLogicalColour Colour.LogicalColour.Black	-- 6. Full move counter. 	 ]  instance Property.Empty.Empty Game where@@ -396,34 +396,32 @@ 	}  instance StateProperty.Hashable.Hashable Game where-	listRandoms game@MkGame {+	listRandoms zobrist game@MkGame { 		getNextLogicalColour			= nextLogicalColour, 		getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour, 		getBoard				= board-	} zobrist	= (-		if Attribute.LogicalColour.isBlack nextLogicalColour+	} = (+		if Colour.LogicalColour.isBlack nextLogicalColour 			then (Component.Zobrist.getRandomForBlacksMove zobrist :) 			else id-	 ) . Data.Maybe.maybe id (-		(++) . (`StateProperty.Hashable.listRandoms` zobrist)-	 ) (+	 ) $ StateProperty.Hashable.listRandoms zobrist ( 		maybeLastTurn game >>= State.EnPassantAbscissa.mkMaybeEnPassantAbscissa nextLogicalColour ( 			State.Board.getMaybePieceByCoordinates board-		)-	 ) $ StateProperty.Hashable.listRandoms castleableRooksByLogicalColour zobrist ++ StateProperty.Hashable.listRandoms board zobrist+		),+		castleableRooksByLogicalColour,+		board+	 ) -- Triple.  -- | Smart constructor. mkGame-	:: Attribute.LogicalColour.LogicalColour	-- ^ The player who is required to move next.+	:: Colour.LogicalColour.LogicalColour	-- ^ The player who is required to move next. 	-> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour 	-> State.Board.Board 	-> State.CastleableRooksByLogicalColour.TurnsByLogicalColour 	-> Game mkGame nextLogicalColour castleableRooksByLogicalColour board turnsByLogicalColour 	| not . StateProperty.Censor.hasBothKings $ State.Board.getCoordinatesByRankByLogicalColour board	= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Model.Game.mkGame:\tboth Kings must exist; " $ shows board "."-	| State.Board.isKingChecked (-		Property.Opposable.getOpposite nextLogicalColour-	) board		= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Model.Game.mkGame:\tthe player who last moved, is still checked; " $ shows board "."+	| State.Board.isKingChecked board $ Property.Opposable.getOpposite nextLogicalColour			= Control.Exception.throw . Data.Exception.mkInvalidDatum . showString "BishBosh.Model.Game.mkGame:\tthe player who last moved, is still checked; " $ shows board "." 	| otherwise	= game 	where 		game = MkGame {@@ -431,10 +429,10 @@ 			getCastleableRooksByLogicalColour		= castleableRooksByLogicalColour, 			getBoard					= board, 			getTurnsByLogicalColour				= turnsByLogicalColour,-			getMaybeChecked					= Data.List.find (`State.Board.isKingChecked` board) Property.FixedMembership.members,+			getMaybeChecked					= Data.List.find (State.Board.isKingChecked board) Property.FixedMembership.members, 			getInstancesByPosition				= State.InstancesByPosition.mkSingleton $ mkPosition game, 			getAvailableQualifiedMovesByLogicalColour	= Map.fromAscList [-				(logicalColour, mkAvailableQualifiedMovesFor logicalColour game) |+				(logicalColour, mkAvailableQualifiedMovesFor game logicalColour) | 					logicalColour	<- Property.FixedMembership.members, 					getMaybeChecked game /= Just logicalColour	-- Define the available qualified moves for unchecked players only. 			], -- List-comprehension.@@ -451,7 +449,7 @@ 		* There're zero previous turns. -} fromBoard :: State.Board.Board -> Game-fromBoard board	= mkGame Attribute.LogicalColour.White (+fromBoard board	= mkGame Colour.LogicalColour.White ( 	State.CastleableRooksByLogicalColour.fromBoard board  ) board Property.Empty.empty {-TurnsByLogicalColour-} @@ -461,8 +459,8 @@ 	getNextLogicalColour	= nextLogicalColour, 	getTurnsByLogicalColour	= turnsByLogicalColour } = uncurry ToolShed.Data.List.interleave $ (-	State.TurnsByLogicalColour.dereference (Property.Opposable.getOpposite nextLogicalColour) &&& State.TurnsByLogicalColour.dereference nextLogicalColour- ) turnsByLogicalColour+	State.TurnsByLogicalColour.dereference turnsByLogicalColour . Property.Opposable.getOpposite &&& State.TurnsByLogicalColour.dereference turnsByLogicalColour+ ) nextLogicalColour  -- | Gets the sequence of /turn/s in the order they occured. listTurnsChronologically :: Game -> [Component.Turn.Turn]@@ -473,9 +471,7 @@ maybeLastTurn MkGame { 	getNextLogicalColour	= nextLogicalColour, 	getTurnsByLogicalColour	= turnsByLogicalColour-} = Data.Maybe.listToMaybe $ State.TurnsByLogicalColour.dereference (-	Property.Opposable.getOpposite nextLogicalColour- ) turnsByLogicalColour+} = Data.Maybe.listToMaybe . State.TurnsByLogicalColour.dereference turnsByLogicalColour $ Property.Opposable.getOpposite nextLogicalColour  {- | 	* Returns the castling /move/s currently available to the @King@ of the specified /logical colour/.@@ -484,26 +480,28 @@  	* CAVEAT: this is a performance-hotspot; refactor => re-profile. -}-findAvailableCastlingMoves :: Attribute.LogicalColour.LogicalColour -> Game -> [Component.QualifiedMove.QualifiedMove]-findAvailableCastlingMoves logicalColour MkGame {+findAvailableCastlingMoves :: Game -> Colour.LogicalColour.LogicalColour -> [Component.QualifiedMove.QualifiedMove]+findAvailableCastlingMoves MkGame { 	getCastleableRooksByLogicalColour	= castleableRooksByLogicalColour, 	getBoard				= board, 	getMaybeChecked				= maybeChecked-}+} logicalColour 	| Just checkedLogicalColour	<- maybeChecked 	, checkedLogicalColour == logicalColour	= []	-- One can't Castle out of check.-	| Just rooksStartingXs	<- State.CastleableRooksByLogicalColour.locateForLogicalColour logicalColour castleableRooksByLogicalColour	= [+	| Just rooksStartingXs	<- State.CastleableRooksByLogicalColour.locateForLogicalColour castleableRooksByLogicalColour logicalColour	= [ 		Component.QualifiedMove.mkQualifiedMove castlingKingsMove $ Component.CastlingMove.getMoveType castlingMove | 			x		<- rooksStartingXs, 			castlingMove	<- Component.CastlingMove.getCastlingMoves logicalColour, 			let castlingRooksSource	= Component.Move.getSource $ Component.CastlingMove.getRooksMove castlingMove, 			Cartesian.Coordinates.getX castlingRooksSource == x, 			State.MaybePieceByCoordinates.isClear (+				State.Board.getMaybePieceByCoordinates board+			) ( 				Cartesian.Coordinates.kingsStartingCoordinates logicalColour-			) castlingRooksSource $ State.Board.getMaybePieceByCoordinates board,+			) castlingRooksSource, 			let castlingKingsMove	= Component.CastlingMove.getKingsMove castlingMove, 			all (-				null . ($ board) . State.Board.findAttackersOf logicalColour+				null . State.Board.findAttackersOf board logicalColour 			) $ Component.Move.interpolate castlingKingsMove	-- The King mustn't be checked anywhere alongs its route. 	] {-list-comprehension-} 	| otherwise	= [] {-have already Castled-}@@ -515,7 +513,7 @@ 	-> [Maybe Attribute.Rank.Rank] {-# INLINE listMaybePromotionRanks #-} listMaybePromotionRanks destination piece-	| Component.Piece.isPawnPromotion destination piece	= map Just Attribute.Rank.promotionProspects+	| Component.Piece.isPawnPromotion piece destination	= map Just Attribute.Rank.promotionProspects 	| otherwise						= [Nothing]  -- | The type of a function which transforms a /game/.@@ -541,10 +539,10 @@ } = Control.Exception.assert ( 	not $ isTerminated game	-- CAVEAT: otherwise any resignation will be overwritten.  ) game' where-	((move, moveType), sourceRank)	= (Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType) . Component.Turn.getQualifiedMove &&& Component.Turn.getRank $ turn	-- Deconstruct.+	((move, moveType), sourceRank)	= (Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType) . Component.Turn.getQualifiedMove &&& Component.Turn.getRank $! turn	-- Deconstruct. 	(source, destination)		= Component.Move.getSource &&& Component.Move.getDestination $ move	-- Deconstruct. -	opponentsLogicalColour :: Attribute.LogicalColour.LogicalColour+	opponentsLogicalColour :: Colour.LogicalColour.LogicalColour 	opponentsLogicalColour	= Property.Opposable.getOpposite nextLogicalColour  	inferredRooksMove	= Data.Maybe.maybe (@@ -566,9 +564,10 @@ 		getCastleableRooksByLogicalColour		= State.CastleableRooksByLogicalColour.takeTurn nextLogicalColour turn castleableRooksByLogicalColour, 		getBoard					= board', 		getTurnsByLogicalColour				= State.TurnsByLogicalColour.prepend nextLogicalColour turn turnsByLogicalColour,-		getMaybeChecked					= Data.List.find (`State.Board.isKingChecked` board') [opponentsLogicalColour],+		getMaybeChecked					= Data.List.find (State.Board.isKingChecked board') [opponentsLogicalColour], 		getInstancesByPosition				= State.InstancesByPosition.insertPosition (Component.Turn.getIsRepeatableMove turn) (mkPosition game') instancesByPosition, 		getAvailableQualifiedMovesByLogicalColour	= let+			moveEndpoints :: [Cartesian.Coordinates.Coordinates] 			moveEndpoints	= ( 				case moveType of 					Attribute.MoveType.Castle _	-> (++) [@@ -579,10 +578,12 @@ 					_				-> id 			 ) [source, destination] +			kingsByCoordinates :: [Component.Piece.LocatedPiece] 			kingsByCoordinates	= map (-				(`State.CoordinatesByRankByLogicalColour.getKingsCoordinates` State.Board.getCoordinatesByRankByLogicalColour board') &&& Component.Piece.mkKing+				State.CoordinatesByRankByLogicalColour.getKingsCoordinates (State.Board.getCoordinatesByRankByLogicalColour board') &&& Component.Piece.mkKing 			 ) Property.FixedMembership.members +			affected, affected'	:: [Component.Piece.LocatedPiece] 			(affected, affected')	= ( 				Data.List.nub . (:) ( 					destination,@@ -591,33 +592,30 @@ 			 ) . Data.List.partition ( 				(== nextLogicalColour) . Component.Piece.getLogicalColour . snd {-piece-} 			 ) . (-				if Component.Turn.isPawnDoubleAdvance nextLogicalColour turn+				if Component.Turn.isPawnDoubleAdvance turn nextLogicalColour 					then (++) [ 						(pawnCoordinates, oppositePiece) | 							let oppositePiece	= Component.Piece.mkPiece opponentsLogicalColour sourceRank, 							pawnCoordinates	<- Cartesian.Coordinates.getAdjacents destination,-							State.MaybePieceByCoordinates.dereference pawnCoordinates (State.Board.getMaybePieceByCoordinates board) == Just oppositePiece	-- Find any opposing Pawn which can capture En-passant.+							State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) pawnCoordinates == Just oppositePiece	-- Find any opposing Pawn which can capture En-passant. 					] {-list-comprehension-} 					else id 			 ) $ kingsByCoordinates {-moves available to either King may be constrained or liberated, even if misaligned with move-endpoints-} ++ [ 				(knightsCoordinates, Component.Piece.mkKnight knightsColour) | 					knightsColour		<- Property.FixedMembership.members,	-- The moves for one's own Knights may be have been blocked by a friendly piece occupying an end-point, whereas the moves for opposing Knights will have a new move-type.-					moveEndpoint		<- moveEndpoints,-					knightsCoordinates	<- StateProperty.Seeker.findProximateKnights knightsColour moveEndpoint board'+					knightsCoordinates	<- concatMap (StateProperty.Seeker.findProximateKnights board' knightsColour) moveEndpoints 			 ] {-list-comprehension-} ++ ( 				if sourceRank == Attribute.Rank.King-					then [-						(blockingCoordinates, blockingPiece) |-							(kingsCoordinates, _)			<- kingsByCoordinates,-							direction				<- Property.FixedMembership.members,-							(blockingCoordinates, blockingPiece)	<- Data.Maybe.maybeToList $ State.MaybePieceByCoordinates.findBlockingPiece direction kingsCoordinates maybePieceByCoordinates'-					] -- List-comprehension. Re-evaluate the moves available to all pieces aligned with a King.+					then concatMap (+						flip (+							State.MaybePieceByCoordinates.findBlockingPieces maybePieceByCoordinates'+						) Nothing {-omni-directional-} . fst {-coordinates-}+					) kingsByCoordinates	-- Re-evaluate the moves available to all pieces aligned with a King. 					else [ 						(blockingCoordinates, blockingPiece) | 							(kingsCoordinates, _)			<- kingsByCoordinates,-							moveEndpoint				<- moveEndpoints,-							direction				<- Data.Maybe.maybeToList . Cartesian.Vector.toMaybeDirection $ Cartesian.Vector.measureDistance kingsCoordinates moveEndpoint, -- N.B. null when the King isn't aligned with any move-endpoint.-							let findBlockingPieceFrom coordinates	= State.MaybePieceByCoordinates.findBlockingPiece direction coordinates maybePieceByCoordinates',+							direction				<- Data.Maybe.mapMaybe (Cartesian.Vector.toMaybeDirection . Cartesian.Vector.measureDistance kingsCoordinates) moveEndpoints, -- N.B. null when the King isn't aligned with any move-endpoint.+							let findBlockingPieceFrom	= flip (State.MaybePieceByCoordinates.findBlockingPiece maybePieceByCoordinates') direction, 							(blockingCoordinates, blockingPiece)	<- Data.Maybe.maybeToList $ ( 								\pair@(coordinates, _) -> if coordinates /= destination 									then Just pair@@ -627,28 +625,30 @@ 							) =<< findBlockingPieceFrom kingsCoordinates 					] -- List-comprehension. Re-evaluate the moves available to all pieces aligned with a King & a move-endpoint. 			 ) ++ [-				(coordinates, affectedPiece) |-					moveEndpoint			<- moveEndpoints,-					direction			<- Property.FixedMembership.members,-					(coordinates, affectedPiece)	<- Data.Maybe.maybeToList $ State.MaybePieceByCoordinates.findBlockingPiece direction moveEndpoint maybePieceByCoordinates',-					coordinates /= destination,	-- Added above.-					not . uncurry (||) $ (Component.Piece.isKnight &&& Component.Piece.isKing) affectedPiece,	-- Added above.-					Component.Piece.canMoveBetween coordinates moveEndpoint affectedPiece+				locatedAffectedPiece |+					moveEndpoint		<- moveEndpoints,+					locatedAffectedPiece	<- filter (+						not . uncurry (||) . (+							(== destination) *** uncurry (||) . (+								Component.Piece.isKnight &&& Component.Piece.isKing+							) -- Added above.+						)+					) $ State.MaybePieceByCoordinates.findBlockingPieces maybePieceByCoordinates' moveEndpoint Nothing {-omni-directional-},+					uncurry (flip Component.Piece.canMoveBetween) locatedAffectedPiece moveEndpoint 			 ] -- List-comprehension. Re-evaluate the moves available to all pieces, which either could move to the source, or can now move to the destination, of the requested move. +			insertMovesFrom	:: AvailableQualifiedMoves -> [Component.Piece.LocatedPiece] -> AvailableQualifiedMoves 			insertMovesFrom	= foldr $ \(source', piece') -> let 				logicalColour			= Component.Piece.getLogicalColour piece'-				isSafeDestination destination'	= not $ State.Board.exposesKing logicalColour (Component.Move.mkMove source' destination') board'+				isSafeDestination destination'	= not . State.Board.exposesKing board' logicalColour $ Component.Move.mkMove source' destination' 			 in case [ 				(destination', Attribute.MoveType.EnPassant) |-					Cartesian.Coordinates.isEnPassantRank logicalColour source',+					Cartesian.Coordinates.isEnPassantRank source' logicalColour, 					Component.Piece.isPawn piece',-					destination'	<- Component.Piece.findAttackDestinations source' piece',-					State.MaybePieceByCoordinates.isVacant destination' maybePieceByCoordinates',+					destination'	<- Component.Piece.findAttackDestinations piece' source',+					State.MaybePieceByCoordinates.isVacant maybePieceByCoordinates' destination', 					uncurry (&&) . (-						(== Just (Property.Opposable.getOpposite piece')) . (-							`State.MaybePieceByCoordinates.dereference` maybePieceByCoordinates'-						) &&& (== move) . Component.Move.mkMove (Cartesian.Coordinates.advance logicalColour destination')+						(== Just (Property.Opposable.getOpposite piece')) . State.MaybePieceByCoordinates.dereference maybePieceByCoordinates' &&& (== move) . Component.Move.mkMove (Cartesian.Coordinates.advance logicalColour destination') 					) $ Cartesian.Coordinates.retreat logicalColour destination',	-- Did an opposing Pawn just double-advance to the expected position ? 					isSafeDestination destination' 			 ] {-list-comprehension-} ++ [@@ -656,7 +656,7 @@ 					destination', 					Attribute.MoveType.mkNormalMoveType maybeTakenRank maybePromotionRank 				) |-					(destination', maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor source' piece' maybePieceByCoordinates',+					(destination', maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates' source' piece', 					maybeTakenRank /= Just Attribute.Rank.King,	-- This move can never be made; the option will either be immediately removed or check-mate declared. 					isSafeDestination destination', 					maybePromotionRank		<- listMaybePromotionRanks destination' piece'@@ -664,7 +664,8 @@ 				[]			-> Map.delete source'				-- There're zero moves from here. 				qualifiedDestinations	-> Map.insert source' qualifiedDestinations	-- Overwrite any existing moves. -			insertCastlingMoves logicalColour	= case findAvailableCastlingMoves logicalColour game' of+			insertCastlingMoves :: Colour.LogicalColour.LogicalColour -> AvailableQualifiedMoves -> AvailableQualifiedMoves+			insertCastlingMoves logicalColour	= case findAvailableCastlingMoves game' logicalColour of 				[]			-> id 				validCastlingMoves	-> uncurry ( 					Map.insertWith (++)@@ -676,30 +677,32 @@ 		in ( 			\availableQualifiedMovesByLogicalColour' -> ( 				case (Map.member opponentsLogicalColour availableQualifiedMovesByLogicalColour', Data.Maybe.isJust $ getMaybeChecked game') of-					(True, True)	-> Map.delete opponentsLogicalColour	-- Many changes result from the King being checked.-					(True, _)	-> Map.adjust (-						insertCastlingMoves opponentsLogicalColour . (-							`insertMovesFrom` affected'	-- Reconstruct any moves for affected pieces.-						) . (-							if Attribute.MoveType.isEnPassant moveType-								then Map.delete $ Cartesian.Coordinates.retreat nextLogicalColour destination-								else id-						) . Map.delete destination	-- Delete the moves originally available to any taken piece.-					 ) opponentsLogicalColour-					(_, True)	-> id	-- We neither want an entry in the map, nor is there one.-					_		-> Map.insert opponentsLogicalColour $ mkAvailableQualifiedMovesFor opponentsLogicalColour game'	-- Reconstruct.+					(True, isChecked)+						| isChecked	-> Map.delete opponentsLogicalColour	-- Many changes result from the King being checked.+						| otherwise	-> Map.adjust (+							insertCastlingMoves opponentsLogicalColour . (+								`insertMovesFrom` affected'	-- Reconstruct any moves for affected pieces.+							) . (+								if Attribute.MoveType.isEnPassant moveType+									then Map.delete $ Cartesian.Coordinates.retreat nextLogicalColour destination+									else id+							) . Map.delete destination	-- Delete the moves originally available to any taken piece.+						) opponentsLogicalColour+					(_, isChecked)+						| isChecked	-> id	-- We neither want an entry in the map, nor is there one.+						| otherwise	-> Map.insert opponentsLogicalColour $ mkAvailableQualifiedMovesFor game' opponentsLogicalColour	-- Reconstruct. 			) availableQualifiedMovesByLogicalColour' 		) $ ( 			if Data.Maybe.maybe True {-not a member-} ( 				\availableQualifiedMoves -> sourceRank == Attribute.Rank.King || Data.Maybe.maybe False {-zero previous turns-} (-					Component.Turn.isPawnDoubleAdvance opponentsLogicalColour+					`Component.Turn.isPawnDoubleAdvance` opponentsLogicalColour 				) ( 					maybeLastTurn game	-- I.E. one's opponent. 				) {-only required for efficiency-} && Data.Foldable.any ( 					any $ Attribute.MoveType.isEnPassant . snd {-moveType-} 				) availableQualifiedMoves 			) $ Map.lookup nextLogicalColour availableQualifiedMovesByLogicalColour-				then Map.insert nextLogicalColour $ mkAvailableQualifiedMovesFor nextLogicalColour game'	-- Reconstruct.+				then Map.insert nextLogicalColour $ mkAvailableQualifiedMovesFor game' nextLogicalColour	-- Reconstruct. 				else Map.adjust ( 					insertCastlingMoves nextLogicalColour . ( 						`insertMovesFrom` affected	-- Reconstruct any moves for affected pieces.@@ -712,8 +715,8 @@ -- | Construct a /turn/ & relay the request to 'takeTurn'. applyQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Transformation applyQualifiedMove qualifiedMove game@MkGame { getBoard = board }-	| Just piece	<- State.MaybePieceByCoordinates.dereference (Component.Move.getSource move) $ State.Board.getMaybePieceByCoordinates board-	= takeTurn (Component.Turn.mkTurn qualifiedMove $ Component.Piece.getRank piece) game+	| Just piece	<- State.MaybePieceByCoordinates.dereference (State.Board.getMaybePieceByCoordinates board) $! Component.Move.getSource move+			= takeTurn (Component.Turn.mkTurn qualifiedMove $! Component.Piece.getRank piece) game 	| otherwise	= Control.Exception.throw . Data.Exception.mkSearchFailure . showString "BishBosh.Model.Game.applyQualifiedMove:\tthere isn't a piece at the source of " . shows move . showString "; " $ shows game "." 	where 		move	= Component.QualifiedMove.getMove qualifiedMove@@ -722,7 +725,7 @@ applyEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove -> Transformation applyEitherQualifiedMove eitherQualifiedMove game@MkGame { getBoard = board } = applyQualifiedMove ( 	Component.QualifiedMove.mkQualifiedMove move . (-		($ State.Board.getMaybePieceByCoordinates board) . State.MaybePieceByCoordinates.inferMoveType move ||| id+		State.MaybePieceByCoordinates.inferMoveType (State.Board.getMaybePieceByCoordinates board) move ||| id 	) $ Component.EitherQualifiedMove.getPromotionRankOrMoveType eitherQualifiedMove  ) game where 	move	= Component.EitherQualifiedMove.getMove eitherQualifiedMove@@ -743,7 +746,7 @@ 					datum, 					showString "board" . Text.ShowList.showsAssociation . shows (getBoard game) . showString " (" $ shows errorMessage ")" 				) -- Pair.-			) $ validateEitherQualifiedMove eitherQualifiedMove game+			) $ validateEitherQualifiedMove game eitherQualifiedMove 		) $ moveConstructor datum 	)  ) . Right@@ -754,18 +757,18 @@ 	* N.B.: it is considered valid to take a @King@, one just never has the opportunity, since the game terminates the move before. -} validateQualifiedMove-	:: Component.QualifiedMove.QualifiedMove-	-> Game	-- ^ Prior to playing the /qualified move/.+	:: Game	-- ^ Prior to playing the /qualified move/.+	-> Component.QualifiedMove.QualifiedMove 	-> Maybe String	-- ^ Error-message.-validateQualifiedMove qualifiedMove game@MkGame {+validateQualifiedMove game@MkGame { 	getNextLogicalColour		= nextLogicalColour, 	getBoard			= board, 	getMaybeChecked			= maybeChecked, 	getMaybeTerminationReason	= maybeTerminationReason-} = Control.Exception.assert (+} qualifiedMove = Control.Exception.assert ( 	StateProperty.Censor.hasBothKings ( 		State.Board.getCoordinatesByRankByLogicalColour board-	) && maybeChecked == Data.List.find (`State.Board.isKingChecked` board) Property.FixedMembership.members+	) && maybeChecked == Data.List.find (State.Board.isKingChecked board) Property.FixedMembership.members  ) $ Data.Maybe.maybe ( 	Data.Maybe.maybe ( 		Just "there isn't a piece at the specified source-coordinates"	-- N.B.: this is also caught by 'validateEitherQualifiedMove'.@@ -796,19 +799,19 @@ 			( 				case Component.Piece.getRank sourcePiece of 					Attribute.Rank.Pawn-						| destination `elem` Component.Piece.findAttackDestinations source sourcePiece	-> Data.Maybe.maybe (+						| destination `elem` Component.Piece.findAttackDestinations sourcePiece source	-> Data.Maybe.maybe ( 							let 								opponentsCoordinates	= Cartesian.Coordinates.retreat sourceLogicalColour destination 								opponentsPawn		= Property.Opposable.getOpposite sourcePiece 							in [ 								(-									not $ Cartesian.Coordinates.isEnPassantRank sourceLogicalColour source,+									not $ Cartesian.Coordinates.isEnPassantRank source sourceLogicalColour, 									showString "one can't take a '" $ shows opponentsPawn "' en-passant, from this rank" 								), (-									State.MaybePieceByCoordinates.isOccupied destination maybePieceByCoordinates,+									State.MaybePieceByCoordinates.isOccupied maybePieceByCoordinates destination, 									showString "taking a '" $ shows opponentsPawn "' en-passant, requires a move to a vacant square" 								), (-									State.MaybePieceByCoordinates.dereference opponentsCoordinates maybePieceByCoordinates /= Just opponentsPawn,+									State.MaybePieceByCoordinates.dereference maybePieceByCoordinates opponentsCoordinates /= Just opponentsPawn, 									shows "en-passant" . showString " requires a '" $ shows opponentsPawn "' to be taken" 								), ( 									Data.Maybe.maybe True {-zero previous turns-} (@@ -827,14 +830,14 @@ 							"it may only have a sideways component during attack" 						) : ( 							case (-								if Attribute.LogicalColour.isBlack sourceLogicalColour+								if Colour.LogicalColour.isBlack sourceLogicalColour 									then negate 									else id 							) $ Cartesian.Vector.getYDistance distance of 								1	-> id 								2	-> (++) [ 									(-										not $ Cartesian.Coordinates.isPawnsFirstRank sourceLogicalColour source,+										not $ Cartesian.Coordinates.isPawnsFirstRank source sourceLogicalColour, 										"it only has the option to advance two squares on its first move" 									), ( 										isObstructed,@@ -899,10 +902,10 @@ 							( 								\rooksSource -> [ 									(-										not . State.CastleableRooksByLogicalColour.canCastleWith sourceLogicalColour rooksSource $ getCastleableRooksByLogicalColour game,+										not $ State.CastleableRooksByLogicalColour.canCastleWith (getCastleableRooksByLogicalColour game) sourceLogicalColour rooksSource, 										showString "it has either already castled or lost the right to castle with the implied '" $ shows (Component.Piece.mkRook sourceLogicalColour) "'" 									), (-										State.MaybePieceByCoordinates.isObstructed source rooksSource maybePieceByCoordinates,+										State.MaybePieceByCoordinates.isObstructed maybePieceByCoordinates source rooksSource, 										"it can't castle through an obstruction" 									) 								]@@ -918,7 +921,7 @@ 								"it can't castle out of check" 							), ( 								not . all (-									null . ($ board) . State.Board.findAttackersOf sourceLogicalColour+									null . State.Board.findAttackersOf board sourceLogicalColour 								) $ Component.Move.interpolate move,	-- The King mustn't pass through check when moving from source to destination (inclusive); a long castle still permits the square right of the Rook to be checked. 								"it can't castle through check" 							)@@ -930,57 +933,57 @@ 						else showString "your '" . shows (Component.Piece.mkKing sourceLogicalColour) . showChar '\'' 				) $ if maybeChecked == Just sourceLogicalColour 					then (-						State.Board.isKingChecked sourceLogicalColour $ State.Board.movePiece move (Just moveType) board,	-- CAVEAT: don't perform an unvalidated move at the Game-level.+						State.Board.isKingChecked (State.Board.movePiece move (Just moveType) board) sourceLogicalColour,	-- CAVEAT: don't perform an unvalidated move at the Game-level. 						" remains checked" 					) -- Pair. 					else (-						State.Board.exposesKing sourceLogicalColour move board,+						State.Board.exposesKing board sourceLogicalColour move, 						" would become exposed" 					) -- Pair. 			] -- Post-move tests on one's King. 		)-	) $ State.MaybePieceByCoordinates.dereference source maybePieceByCoordinates+	) $ State.MaybePieceByCoordinates.dereference maybePieceByCoordinates source  ) ( 	Just . show	-- The game has been terminated, so there aren't any valid moves.  ) maybeTerminationReason where 	(move, moveType)	= Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType $ qualifiedMove 	(source, destination)	= Component.Move.getSource &&& Component.Move.getDestination $ move	-- Deconstruct. 	maybePieceByCoordinates	= State.Board.getMaybePieceByCoordinates board-	maybeDestinationPiece	= State.MaybePieceByCoordinates.dereference destination maybePieceByCoordinates	-- Query.+	maybeDestinationPiece	= State.MaybePieceByCoordinates.dereference maybePieceByCoordinates destination	-- Query. 	distance		= Component.Move.measureDistance move  	isObstructed :: Bool-	isObstructed	= State.MaybePieceByCoordinates.isObstructed source destination maybePieceByCoordinates+	isObstructed	= State.MaybePieceByCoordinates.isObstructed maybePieceByCoordinates source destination  -- | Validates the /move-type/ then forwards the request to 'validateQualifiedMove'. validateEitherQualifiedMove-	:: Component.EitherQualifiedMove.EitherQualifiedMove-	-> Game	-- ^ Prior to playing the /move/.+	:: Game	-- ^ Prior to playing the /move/.+	-> Component.EitherQualifiedMove.EitherQualifiedMove 	-> Maybe String	-- ^ Error-message.-validateEitherQualifiedMove eitherQualifiedMove game@MkGame { getBoard = board }-	| State.MaybePieceByCoordinates.isVacant (+validateEitherQualifiedMove game@MkGame { getBoard = board } eitherQualifiedMove+	| State.MaybePieceByCoordinates.isVacant maybePieceByCoordinates ( 		Component.Move.getSource move-	) maybePieceByCoordinates		= Just "there isn't a piece at the specified source-coordinates"	-- Guard the call to 'State.MaybePieceByCoordinates.inferMoveType'.+	)		= Just "there isn't a piece at the specified source-coordinates"	-- Guard the call to 'State.MaybePieceByCoordinates.inferMoveType'. 	| Right moveType	<- promotionRankOrMoveType 	, moveType /= inferredMoveType		= Just . showString "the implied " . showString Attribute.MoveType.tag . Text.ShowList.showsAssociation . shows moveType . showString " /= " $ show inferredMoveType-	| otherwise				= validateQualifiedMove (Component.QualifiedMove.mkQualifiedMove move inferredMoveType) game+	| otherwise				= validateQualifiedMove game $ Component.QualifiedMove.mkQualifiedMove move inferredMoveType 	where 		(move, promotionRankOrMoveType)	= Component.EitherQualifiedMove.getMove &&& Component.EitherQualifiedMove.getPromotionRankOrMoveType $ eitherQualifiedMove  		maybePieceByCoordinates		= State.Board.getMaybePieceByCoordinates board  		inferredMoveType :: Attribute.MoveType.MoveType-		inferredMoveType	= State.MaybePieceByCoordinates.inferMoveType move (-			id ||| Attribute.Rank.getMaybePromotionRank $ promotionRankOrMoveType	-- Discard any move-type.-		 ) maybePieceByCoordinates+		inferredMoveType	= State.MaybePieceByCoordinates.inferMoveType maybePieceByCoordinates move $ (+			id ||| Attribute.Rank.getMaybePromotionRank+		 ) promotionRankOrMoveType	-- Discard any move-type.  -- | Whether the specified /QualifiedMove/ is valid.-isValidQualifiedMove :: Component.QualifiedMove.QualifiedMove -> Game -> Bool-isValidQualifiedMove qualifiedMove	= Data.Maybe.isNothing . validateQualifiedMove qualifiedMove+isValidQualifiedMove :: Game -> Component.QualifiedMove.QualifiedMove -> Bool+isValidQualifiedMove game	= Data.Maybe.isNothing . validateQualifiedMove game  -- | Whether the specified /EitherQualifiedMove/ is valid.-isValidEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove -> Game -> Bool-isValidEitherQualifiedMove eitherQualifiedMove	= Data.Maybe.isNothing . validateEitherQualifiedMove eitherQualifiedMove+isValidEitherQualifiedMove :: Game -> Component.EitherQualifiedMove.EitherQualifiedMove -> Bool+isValidEitherQualifiedMove game	= Data.Maybe.isNothing . validateEitherQualifiedMove game  {- | 	* Roll-back the specified /game/ until the start, returning each previous /game/ paired with the /ply/ which was then made.@@ -996,7 +999,7 @@ 		getInstancesByPosition	= instancesByPosition 	} -> let 		previousColour	= Property.Opposable.getOpposite nextLogicalColour-	 in case State.TurnsByLogicalColour.dereference previousColour turnsByLogicalColour of+	 in case State.TurnsByLogicalColour.dereference turnsByLogicalColour previousColour of 		turn : previousTurns	-> let 			(move, moveType)	= (Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType) $ Component.Turn.getQualifiedMove turn	-- Deconstruct. 			destination		= Component.Move.getDestination move	-- Deconstruct.@@ -1006,10 +1009,10 @@ 				getTurnsByLogicalColour	= turnsByLogicalColour', 				getMaybeChecked		= maybeChecked' 			} = game {-				getNextLogicalColour			= previousColour,-				getCastleableRooksByLogicalColour	= State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour turnsByLogicalColour',-				getMaybeChecked				= Data.List.find (`State.Board.isKingChecked` board') [previousColour],-				getBoard				= (+				getNextLogicalColour				= previousColour,+				getCastleableRooksByLogicalColour		= State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour turnsByLogicalColour',+				getMaybeChecked					= Data.List.find (State.Board.isKingChecked board') [previousColour],+				getBoard					= ( 					case moveType of 						Attribute.MoveType.Castle isShort	-> State.Board.movePiece ( 							uncurry Component.Move.mkMove $ (@@ -1033,16 +1036,16 @@ 				 ) ( 					Attribute.MoveType.getMaybeExplicitlyTakenRank moveType	-- Reconstruct any piece taken (except en-passant), inferring the logical colour. 				 ) $ State.Board.movePiece (Property.Opposable.getOpposite move) Nothing {-MoveType-} board,	-- N.B.: operate directly on the board to avoid creating a new Turn in the Game-structure.-				getTurnsByLogicalColour	= State.TurnsByLogicalColour.update turnsByLogicalColour [(previousColour, previousTurns)],-				getInstancesByPosition	= if Component.Turn.getIsRepeatableMove turn+				getTurnsByLogicalColour				= State.TurnsByLogicalColour.update [(previousColour, previousTurns)] turnsByLogicalColour,+				getInstancesByPosition				= if Component.Turn.getIsRepeatableMove turn 					then State.InstancesByPosition.deletePosition (mkPosition game) instancesByPosition 					else mkInstancesByPosition game',	-- Reconstruct the map prior to the unrepeatable move. 				getAvailableQualifiedMovesByLogicalColour	= Map.fromAscList [-					(logicalColour, mkAvailableQualifiedMovesFor logicalColour game') |+					id &&& mkAvailableQualifiedMovesFor game' $ logicalColour | 						logicalColour	<- Property.FixedMembership.members, 						maybeChecked' /= Just logicalColour 				], -- List-comprehension.-				getMaybeTerminationReason	= Nothing+				getMaybeTerminationReason			= Nothing 			} 		 in Just ((game', turn), game') 		_	-> Nothing@@ -1054,23 +1057,23 @@ 	* CAVEAT: to avoid an infinite loop, this doesn't check whether the game has already terminated. -} listQualifiedMovesAvailableTo-	:: Attribute.LogicalColour.LogicalColour	-- ^ Define the player for whom the moves are required.-	-> Game+	:: Game+	-> Colour.LogicalColour.LogicalColour	-- ^ Define the player for whom the moves are required. 	-> [Component.QualifiedMove.QualifiedMove]-listQualifiedMovesAvailableTo logicalColour game@MkGame {+listQualifiedMovesAvailableTo game@MkGame { 	getBoard	= board, 	getMaybeChecked	= maybeChecked-}+} logicalColour 	| maybeChecked == Just logicalColour = let-		kingsCoordinates	= State.CoordinatesByRankByLogicalColour.getKingsCoordinates logicalColour coordinatesByRankByLogicalColour+		kingsCoordinates	= State.CoordinatesByRankByLogicalColour.getKingsCoordinates coordinatesByRankByLogicalColour logicalColour 	in [ 		Component.QualifiedMove.mkQualifiedMove move moveType |-			(destination, maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor kingsCoordinates (Component.Piece.mkKing logicalColour) maybePieceByCoordinates,+			(destination, maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates kingsCoordinates $ Component.Piece.mkKing logicalColour, 			let 				move		= Component.Move.mkMove kingsCoordinates destination 				moveType	= Attribute.MoveType.mkNormalMoveType maybeTakenRank Nothing {-promotion-rank-},-			null . State.Board.findAttackersOf logicalColour destination $ State.Board.movePiece move (Just moveType) board -- Avoid moving the King into another check. CAVEAT: one can't merely use 'Board.exposesKing' since that assumes that one isn't already checked.-	] {-list-comprehension-} ++ case State.Board.findAttackersOf logicalColour kingsCoordinates board of+			null $ State.Board.findAttackersOf (State.Board.movePiece move (Just moveType) board) logicalColour destination -- Avoid moving the King into another check. CAVEAT: one can't merely use 'Board.exposesKing' since that assumes that one isn't already checked.+	] {-list-comprehension-} ++ case State.Board.findAttackersOf board logicalColour kingsCoordinates of 		[(checkedFrom, checkedByRank)]	-> Control.Exception.assert (checkedByRank /= Attribute.Rank.King) . filter isSafeQualifiedMove $ ( 			if checkedByRank == Attribute.Rank.Pawn 				then Data.Maybe.maybe [] {-CAVEAT: this can occur if the game has just been read from FEN-} (@@ -1082,9 +1085,9 @@ 							Component.QualifiedMove.mkQualifiedMove ( 								Component.Move.mkMove source $ Cartesian.Coordinates.advance logicalColour lastDestination	-- Construct a move which takes the attacker. 							) Attribute.MoveType.enPassant |-								Component.Move.isPawnDoubleAdvance opponentsLogicalColour lastMove,+								Component.Move.isPawnDoubleAdvance lastMove opponentsLogicalColour, 								source	<- Cartesian.Coordinates.getAdjacents lastDestination,-								State.MaybePieceByCoordinates.dereference source maybePieceByCoordinates == Just pawn+								State.MaybePieceByCoordinates.dereference maybePieceByCoordinates source == Just pawn 						] -- List-comprehension. 					) . Component.QualifiedMove.getMove . Component.Turn.getQualifiedMove 				) $ maybeLastTurn game	-- The King is checked by a Pawn, which must also have been the last piece to move.@@ -1093,7 +1096,7 @@ 			Component.QualifiedMove.mkQualifiedMove ( 				Component.Move.mkMove source checkedFrom	-- Construct a move which takes the attacker. 			) $ Attribute.MoveType.mkNormalMoveType (Just checkedByRank) maybePromotionRank |-				(source, attackersRank)	<- State.Board.findAttackersOf opponentsLogicalColour checkedFrom board,	-- See if the attacker can be taken (excluding en-passant).+				(source, attackersRank)	<- State.Board.findAttackersOf board opponentsLogicalColour checkedFrom,	-- See if the attacker can be taken (excluding en-passant). 				attackersRank /= Attribute.Rank.King,	-- The King can take its attacker, but it's already addressed above. 				maybePromotionRank	<- listMaybePromotionRanks checkedFrom {-destination-} $ Component.Piece.mkPiece logicalColour attackersRank 		 ] {-list-comprehension-} ++ [@@ -1103,26 +1106,26 @@ 				checkedByRank /= Attribute.Rank.Knight,	-- A Knight can't be blocked. 				rank			<- Attribute.Rank.expendable,	-- Find pieces that might be able to block the checking piece. 				let piece	= Component.Piece.mkPiece logicalColour rank,-				source			<- State.CoordinatesByRankByLogicalColour.dereference logicalColour rank coordinatesByRankByLogicalColour,	-- Find the source of a potential blocking move.-				(destination, Nothing)	<- State.MaybePieceByCoordinates.listDestinationsFor source piece maybePieceByCoordinates,	-- The blocker must move to an empty square, otherwise the checker was already blocked.+				source			<- State.CoordinatesByRankByLogicalColour.dereference coordinatesByRankByLogicalColour logicalColour rank,	-- Find the source of a potential blocking move.+				(destination, Nothing)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates source piece,	-- The blocker must move to an empty square, otherwise the checker was already blocked. 				Control.Exception.assert (checkedFrom /= kingsCoordinates) . elem destination . init {-drop King's location-} $ Cartesian.Coordinates.interpolate checkedFrom kingsCoordinates, 				maybePromotionRank	<- listMaybePromotionRanks destination piece 		 ] -- List-comprehension. 		attackers		-> Control.Exception.assert ( 			length attackers == 2	-- Triple-check isn't possible. 		 ) []	-- If checked by more than one piece, then the King must be moved; see options above.-	| otherwise {-not checked-}	= findAvailableCastlingMoves logicalColour game ++ filter isSafeQualifiedMove (+	| otherwise {-not checked-}	= findAvailableCastlingMoves game logicalColour ++ filter isSafeQualifiedMove ( 		[ 			Component.QualifiedMove.mkQualifiedMove ( 				Component.Move.mkMove source destination 			) Attribute.MoveType.enPassant | 				let pawn	= Component.Piece.mkPawn logicalColour,-				source		<- State.CoordinatesByRankByLogicalColour.dereference logicalColour Attribute.Rank.Pawn coordinatesByRankByLogicalColour,-				Cartesian.Coordinates.isEnPassantRank logicalColour source,-				destination	<- Component.Piece.findAttackDestinations source pawn,-				State.MaybePieceByCoordinates.isVacant destination maybePieceByCoordinates,+				source		<- State.CoordinatesByRankByLogicalColour.dereference coordinatesByRankByLogicalColour logicalColour Attribute.Rank.Pawn,+				Cartesian.Coordinates.isEnPassantRank source logicalColour,+				destination	<- Component.Piece.findAttackDestinations pawn source,+				State.MaybePieceByCoordinates.isVacant maybePieceByCoordinates destination, 				let opponentsCoordinates	= Cartesian.Coordinates.retreat logicalColour destination,-				State.MaybePieceByCoordinates.dereference opponentsCoordinates maybePieceByCoordinates == Just (Property.Opposable.getOpposite pawn),+				State.MaybePieceByCoordinates.dereference maybePieceByCoordinates opponentsCoordinates == Just (Property.Opposable.getOpposite pawn), 				Data.Maybe.maybe False {-zero previous turns-} ( 					uncurry (&&) . ( 						(== opponentsCoordinates) . Component.Move.getDestination &&& (@@ -1134,8 +1137,8 @@ 			Component.QualifiedMove.mkQualifiedMove ( 				Component.Move.mkMove source destination 			) $ Attribute.MoveType.mkNormalMoveType maybeTakenRank maybePromotionRank |-				(source, piece)			<- State.CoordinatesByRankByLogicalColour.findPiecesOfColour logicalColour coordinatesByRankByLogicalColour,-				(destination, maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor source piece maybePieceByCoordinates,+				(source, piece)			<- State.CoordinatesByRankByLogicalColour.findPiecesOfColour coordinatesByRankByLogicalColour logicalColour,+				(destination, maybeTakenRank)	<- State.MaybePieceByCoordinates.listDestinationsFor maybePieceByCoordinates source piece, 				maybeTakenRank /= Just Attribute.Rank.King,	-- This move can never be made; the option will either be immediately removed or check-mate declared. 				maybePromotionRank		<- listMaybePromotionRanks destination piece 		] -- List-comprehension.@@ -1143,11 +1146,11 @@ 	where 		opponentsLogicalColour						= Property.Opposable.getOpposite logicalColour 		(maybePieceByCoordinates, coordinatesByRankByLogicalColour)	= State.Board.getMaybePieceByCoordinates &&& State.Board.getCoordinatesByRankByLogicalColour $ board-		isSafeQualifiedMove qualifiedMove				= not $ State.Board.exposesKing logicalColour (Component.QualifiedMove.getMove qualifiedMove) board+		isSafeQualifiedMove qualifiedMove				= not . State.Board.exposesKing board logicalColour $ Component.QualifiedMove.getMove qualifiedMove  -- | Construct 'AvailableQualifiedMoves' for the player of the specified /logical colour/.-mkAvailableQualifiedMovesFor :: Attribute.LogicalColour.LogicalColour -> Game -> AvailableQualifiedMoves-mkAvailableQualifiedMovesFor logicalColour	= foldr {-maintains destination-order-} (+mkAvailableQualifiedMovesFor :: Game -> Colour.LogicalColour.LogicalColour -> AvailableQualifiedMoves+mkAvailableQualifiedMovesFor game	= foldr {-maintains destination-order-} ( 	\qualifiedMove -> let 		move	= Component.QualifiedMove.getMove qualifiedMove 	in Map.insertWith (++) (@@ -1158,7 +1161,7 @@ 			Component.QualifiedMove.getMoveType qualifiedMove 		) -- Pair. 	] {-singleton-}- ) Property.Empty.empty . listQualifiedMovesAvailableTo logicalColour+ ) Property.Empty.empty . listQualifiedMovesAvailableTo game  {- | 	* Retrieve the recorded value, or generate the list of /move/s available to the player of the specified /logical colour/.@@ -1166,31 +1169,31 @@ 	* CAVEAT: doesn't account for game-termination. -} findQualifiedMovesAvailableTo-	:: Attribute.LogicalColour.LogicalColour-	-> Game+	:: Game+	-> Colour.LogicalColour.LogicalColour 	-> [Component.QualifiedMove.QualifiedMove]-findQualifiedMovesAvailableTo logicalColour game@MkGame { getAvailableQualifiedMovesByLogicalColour = availableQualifiedMovesByLogicalColour }+findQualifiedMovesAvailableTo game@MkGame { getAvailableQualifiedMovesByLogicalColour = availableQualifiedMovesByLogicalColour } logicalColour 	| Just availableQualifiedMoves <- Map.lookup logicalColour availableQualifiedMovesByLogicalColour	= [ 		Component.QualifiedMove.mkQualifiedMove (Component.Move.mkMove source destination) moveType | 			(source, qualifiedDestinations)	<- Map.toList availableQualifiedMoves, 			(destination, moveType)		<- qualifiedDestinations 	] -- List-comprehension.-	| otherwise	= listQualifiedMovesAvailableTo logicalColour game	-- Generate the list of moves for this player.+	| otherwise	= listQualifiedMovesAvailableTo game logicalColour	-- Generate the list of moves for this player.  -- | Count the number of plies available to the specified player.-countPliesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game -> Type.Count.NPlies-countPliesAvailableTo logicalColour game@MkGame { getAvailableQualifiedMovesByLogicalColour = availableQualifiedMovesByLogicalColour }+countPliesAvailableTo :: Game -> Colour.LogicalColour.LogicalColour -> Type.Count.NPlies+countPliesAvailableTo game@MkGame { getAvailableQualifiedMovesByLogicalColour = availableQualifiedMovesByLogicalColour } logicalColour 	| isTerminated game	= 0 	| Just availableQualifiedMoves	<- Map.lookup logicalColour availableQualifiedMovesByLogicalColour	-- N.B.: 'findQualifiedMovesAvailableToNextPlayer' unnecessarily constructs a list. 	= fromIntegral $ Data.Foldable.foldl' (\acc -> (+ acc) . length) 0 availableQualifiedMoves-	| otherwise		= fromIntegral . length $ listQualifiedMovesAvailableTo logicalColour game+	| otherwise		= fromIntegral . length $ listQualifiedMovesAvailableTo game logicalColour  -- | Retrieve the recorded value, or generate the list of /move/s available to the next player. findQualifiedMovesAvailableToNextPlayer :: Game -> [Component.QualifiedMove.QualifiedMove]-findQualifiedMovesAvailableToNextPlayer game@MkGame { getNextLogicalColour = nextLogicalColour }	= findQualifiedMovesAvailableTo nextLogicalColour game+findQualifiedMovesAvailableToNextPlayer game@MkGame { getNextLogicalColour = nextLogicalColour }	= findQualifiedMovesAvailableTo game nextLogicalColour  -- | Let the specified player resign.-resignationBy :: Attribute.LogicalColour.LogicalColour -> Transformation+resignationBy :: Colour.LogicalColour.LogicalColour -> Transformation resignationBy logicalColour game 	| isTerminated game	= game	-- Already terminated. 	| otherwise		= game {@@ -1225,7 +1228,7 @@ } 	| haveZeroMoves 	, Just logicalColour <- getMaybeChecked game	= Just $ Rule.GameTerminationReason.mkCheckMate logicalColour-	| otherwise					= fmap Rule.GameTerminationReason.mkDraw maybeDrawReason+	| otherwise					= Rule.GameTerminationReason.mkDraw <$> maybeDrawReason 	where 		haveZeroMoves :: Bool 		haveZeroMoves	= null $ findQualifiedMovesAvailableToNextPlayer game@@ -1296,7 +1299,7 @@ 		(castleableRooksByLogicalColour, castleableRooksByLogicalColour')	= ($ game) &&& ($ game') $ getCastleableRooksByLogicalColour 	in if isCastle || castleableRooksByLogicalColour /= castleableRooksByLogicalColour' 		then (-			State.CastleableRooksByLogicalColour.listIncrementalRandoms castleableRooksByLogicalColour castleableRooksByLogicalColour' zobrist +++			State.CastleableRooksByLogicalColour.listIncrementalRandoms zobrist castleableRooksByLogicalColour castleableRooksByLogicalColour' ++ 		) -- Section. 		else id  ) $ [@@ -1308,9 +1311,9 @@ 				State.Board.getMaybePieceByCoordinates $ getBoard g 			) -- CAVEAT: accounts for any change to the En-passant option, rather than the act of taking En-passant. 		) [game, game'],-		random			<- StateProperty.Hashable.listRandoms enPassantAbscissa zobrist+		random			<- StateProperty.Hashable.listRandoms zobrist enPassantAbscissa  ] {-list-comprehension-} ++ Component.Zobrist.getRandomForBlacksMove zobrist : [-	Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (lastLogicalColour, rankAccessor turn, coordinatesAccessor move) zobrist |+	Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (lastLogicalColour, rankAccessor turn, coordinatesAccessor move) | 		(rankAccessor, coordinatesAccessor)	<- zip [Component.Turn.getRank, (`Data.Maybe.fromMaybe` Attribute.Rank.getMaybePromotionRank moveType) . Component.Turn.getRank] coordinatesAccessors  ] {-list-comprehension-} where 	lastLogicalColour	= getNextLogicalColour game@@ -1322,9 +1325,9 @@ 	coordinatesAccessors	= [Component.Move.getSource, Component.Move.getDestination]  	randomsFromMoveType-		| Just rank <- Attribute.MoveType.getMaybeExplicitlyTakenRank moveType	= [Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (nextLogicalColour, rank, destination) zobrist] -- Singleton.+		| Just rank <- Attribute.MoveType.getMaybeExplicitlyTakenRank moveType	= [Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (nextLogicalColour, rank, destination)] -- Singleton. 		| isCastle	= map (-			\coordinatesAccessor	-> Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (+			\coordinatesAccessor	-> Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist ( 				lastLogicalColour, 				Attribute.Rank.Rook, 				Data.Maybe.maybe (@@ -1334,9 +1337,9 @@ 				) . Data.List.find ( 					(== move) . Component.CastlingMove.getKingsMove 				) $ Component.CastlingMove.getCastlingMoves lastLogicalColour-			) zobrist+			) 		) coordinatesAccessors-		| Attribute.MoveType.isEnPassant moveType	= [Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (nextLogicalColour, Attribute.Rank.Pawn, Cartesian.Coordinates.advance nextLogicalColour destination) zobrist] -- Singleton.+		| Attribute.MoveType.isEnPassant moveType	= [Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour zobrist (nextLogicalColour, Attribute.Rank.Pawn, Cartesian.Coordinates.advance nextLogicalColour destination)] -- Singleton. 		| otherwise	= [] 		where 			nextLogicalColour	= getNextLogicalColour game'