{-
	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@]

	Builds a rose-tree from a /PGN Database/,
	each node of which contains a /move/ qualified by a /move-type/, & possibly also the ultimate result & the game's identifier.
-}

module BishBosh.ContextualNotation.QualifiedMoveForest(
-- * Types
-- ** Type-synonyms
	Name,
	OnymousResult,
--	QualifiedMoveTree,
-- ** Data-types
	QualifiedMoveForest(
--		MkQualifiedMoveForest,
		deconstruct
	),
-- * Functions
	showsNames,
--	drawForest,
	findMinimumPieces,
	count,
-- ** Constructors
	fromPGNDatabase,
	toGameTree,
-- ** Mutators
	mergePGNDatabase,
 ) where

import			Control.Applicative((<|>))
import			Control.Arrow((&&&), (***))
import qualified	BishBosh.Attribute.MoveType		as Attribute.MoveType
import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove
import qualified	BishBosh.Component.Turn			as Component.Turn
import qualified	BishBosh.ContextualNotation.PGN		as ContextualNotation.PGN
import qualified	BishBosh.ContextualNotation.PGNDatabase	as ContextualNotation.PGNDatabase
import qualified	BishBosh.Data.RoseTree			as Data.RoseTree
import qualified	BishBosh.Model.Game			as Model.Game
import qualified	BishBosh.Model.GameTree			as Model.GameTree
import qualified	BishBosh.Notation.MoveNotation		as Notation.MoveNotation
import qualified	BishBosh.Property.Empty			as Property.Empty
import qualified	BishBosh.Property.Null			as Property.Null
import qualified	BishBosh.Rule.GameTerminationReason	as Rule.GameTerminationReason
import qualified	BishBosh.Rule.Result			as Rule.Result
import qualified	BishBosh.State.Board			as State.Board
import qualified	BishBosh.Text.ShowList			as Text.ShowList
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	BishBosh.Type.Length			as Type.Length
import qualified	Control.Arrow
import qualified	Data.Default
import qualified	Data.List
import qualified	Data.Maybe
import qualified	Data.Tree

-- | Each /game/ has a name.
type Name	= String

-- | The name of a /game/, & it's /result/.
type OnymousResult	= (Name, Rule.Result.Result)

{- |
	* Terminal nodes contain the unique name of the /move/-sequence leading to them, from which other information can be found as required, from the original database.

	* N.B.: non-terminal nodes would only need to be labelled with a /name/, if a /game/ exists in the database which is a truncated version of other /game/s in the database.

	* N.B.: provided there are no duplicate /game/s with different /name/s, there's no requirement for more than one /name/ at a node.

	* CAVEAT: since zero moves have been made in the default initial game, the move-tree for the whole game of chess has no apex, so a forest is a more natural structure; though sub-trees can exist.
-}
type QualifiedMoveTree x y	= Data.Tree.Tree (Component.QualifiedMove.QualifiedMove x y, Maybe OnymousResult)

{- |
	* A representation of a PGN-database, where initial /move/s shared between /game/s are merged into the trunk of a tree from which they each branch.

	* Many /game/s will share standard opening /move/s, & a tree-structure (cf. a list) uses this to increase space-time efficiency.

	* Since there are many different initial moves, the structure is a flat-topped /forest/ rather than a single apex /tree/.
-}
newtype QualifiedMoveForest x y	= MkQualifiedMoveForest {
	QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct	:: [QualifiedMoveTree x y]
} deriving (
	QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool
(QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool)
-> (QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool)
-> Eq (QualifiedMoveForest x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y.
(Eq x, Eq y) =>
QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool
/= :: QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool
$c/= :: forall x y.
(Eq x, Eq y) =>
QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool
== :: QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool
$c== :: forall x y.
(Eq x, Eq y) =>
QualifiedMoveForest x y -> QualifiedMoveForest x y -> Bool
Eq,
	Int -> QualifiedMoveForest x y -> ShowS
[QualifiedMoveForest x y] -> ShowS
QualifiedMoveForest x y -> String
(Int -> QualifiedMoveForest x y -> ShowS)
-> (QualifiedMoveForest x y -> String)
-> ([QualifiedMoveForest x y] -> ShowS)
-> Show (QualifiedMoveForest x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y.
(Show x, Show y) =>
Int -> QualifiedMoveForest x y -> ShowS
forall x y. (Show x, Show y) => [QualifiedMoveForest x y] -> ShowS
forall x y. (Show x, Show y) => QualifiedMoveForest x y -> String
showList :: [QualifiedMoveForest x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [QualifiedMoveForest x y] -> ShowS
show :: QualifiedMoveForest x y -> String
$cshow :: forall x y. (Show x, Show y) => QualifiedMoveForest x y -> String
showsPrec :: Int -> QualifiedMoveForest x y -> ShowS
$cshowsPrec :: forall x y.
(Show x, Show y) =>
Int -> QualifiedMoveForest x y -> ShowS
Show	-- CAVEAT: required by QuickCheck, but shouldn't actually be called.
 )

instance Property.Empty.Empty (QualifiedMoveForest x y) where
	empty :: QualifiedMoveForest x y
empty	= [QualifiedMoveTree x y] -> QualifiedMoveForest x y
forall x y. [QualifiedMoveTree x y] -> QualifiedMoveForest x y
MkQualifiedMoveForest [QualifiedMoveTree x y]
forall a. Empty a => a
Property.Empty.empty

instance Property.Null.Null (QualifiedMoveForest x y) where
	isNull :: QualifiedMoveForest x y -> Bool
isNull MkQualifiedMoveForest { deconstruct :: forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct = [] }	= Bool
True
	isNull QualifiedMoveForest x y
_						= Bool
False

instance (Enum x, Enum y) => Notation.MoveNotation.ShowNotation (QualifiedMoveForest x y) where
	showsNotation :: MoveNotation -> QualifiedMoveForest x y -> ShowS
showsNotation MoveNotation
moveNotation MkQualifiedMoveForest { deconstruct :: forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct = [QualifiedMoveTree x y]
forest }	= String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ ((QualifiedMove x y, Maybe OnymousResult) -> String)
-> [QualifiedMoveTree x y] -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest (
		\(QualifiedMove x y
qualifiedMove, Maybe OnymousResult
maybeOnymousResult)	-> MoveNotation -> QualifiedMove x y -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation QualifiedMove x y
qualifiedMove ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS -> (OnymousResult -> ShowS) -> Maybe OnymousResult -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
forall a. a -> a
id (
			\OnymousResult
onymousResult -> Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnymousResult -> ShowS
forall a. Show a => a -> ShowS
shows OnymousResult
onymousResult
		) Maybe OnymousResult
maybeOnymousResult String
""
	 ) [QualifiedMoveTree x y]
forest

-- | Shows an optional capped list of the names of archived games.
showsNames
	:: Maybe Type.Count.NGames	-- ^ The optional maximum number of names to show.
	-> [Name]
	-> ShowS
showsNames :: Maybe Int -> [String] -> ShowS
showsNames Maybe Int
maybeMaximumPGNNames [String]
names	= [ShowS] -> ShowS
Text.ShowList.showsUnterminatedList ([ShowS] -> ShowS) -> ([String] -> [ShowS]) -> [String] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS) -> [String] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (
	\String
name -> String -> ShowS
showString String
"\n\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
name
 ) ([String] -> ShowS) -> [String] -> ShowS
forall a b. (a -> b) -> a -> b
$ ([String] -> [String])
-> (Int -> [String] -> [String])
-> Maybe Int
-> [String]
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [String] -> [String]
forall a. a -> a
id (
	\Int
maximumPGNNames -> (
		if Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maximumPGNNames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names'
			then ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"..."])
			else [String] -> [String]
forall a. a -> a
id
	) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maximumPGNNames)
 ) Maybe Int
maybeMaximumPGNNames [String]
names' where
	names' :: [String]
names'	= [String] -> [String]
forall a. Eq a => [a] -> [a]
Data.List.nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort [String]
names

-- | Include the specified PGN-database into the /forest/, thus allowing more than one 'ContextualNotation.PGNDatabase.PGNDatabase' to be read.
mergePGNDatabase
	:: (Eq x, Eq y)
	=> ContextualNotation.PGNDatabase.PGNDatabase x y
	-> QualifiedMoveForest x y
	-> QualifiedMoveForest x y
mergePGNDatabase :: PGNDatabase x y
-> QualifiedMoveForest x y -> QualifiedMoveForest x y
mergePGNDatabase PGNDatabase x y
pgnDatabase MkQualifiedMoveForest { deconstruct :: forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct = [QualifiedMoveTree x y]
initialForest }	= [QualifiedMoveTree x y] -> QualifiedMoveForest x y
forall x y. [QualifiedMoveTree x y] -> QualifiedMoveForest x y
MkQualifiedMoveForest ([QualifiedMoveTree x y] -> QualifiedMoveForest x y)
-> [QualifiedMoveTree x y] -> QualifiedMoveForest x y
forall a b. (a -> b) -> a -> b
$ (PGN x y -> [QualifiedMoveTree x y] -> [QualifiedMoveTree x y])
-> [QualifiedMoveTree x y]
-> PGNDatabase x y
-> [QualifiedMoveTree x y]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
	\PGN x y
pgn -> OnymousResult
-> [QualifiedMove x y]
-> [QualifiedMoveTree x y]
-> [QualifiedMoveTree x y]
forall x y.
(Eq x, Eq y) =>
OnymousResult
-> [QualifiedMove x y]
-> [QualifiedMoveTree x y]
-> [QualifiedMoveTree x y]
merge (
		PGN x y -> String
forall x y. PGN x y -> String
mkCompositeIdentifier (PGN x y -> String)
-> (PGN x y -> Result) -> PGN x y -> OnymousResult
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Result
-> (GameTerminationReason -> Result)
-> Maybe GameTerminationReason
-> Result
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
			Maybe LogicalColour -> Result
Rule.Result.mkResult Maybe LogicalColour
forall a. Maybe a
Nothing	-- The game is still in progress.
		) GameTerminationReason -> Result
Rule.GameTerminationReason.toResult (Maybe GameTerminationReason -> Result)
-> (PGN x y -> Maybe GameTerminationReason) -> PGN x y -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Maybe GameTerminationReason
forall x y. Game x y -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason (Game x y -> Maybe GameTerminationReason)
-> (PGN x y -> Game x y) -> PGN x y -> Maybe GameTerminationReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGN x y -> Game x y
forall x y. PGN x y -> Game x y
ContextualNotation.PGN.getGame (PGN x y -> OnymousResult) -> PGN x y -> OnymousResult
forall a b. (a -> b) -> a -> b
$ PGN x y
pgn	-- Construct an onymous result.
	) (
		(Turn x y -> QualifiedMove x y)
-> [Turn x y] -> [QualifiedMove x y]
forall a b. (a -> b) -> [a] -> [b]
map Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove ([Turn x y] -> [QualifiedMove x y])
-> (Game x y -> [Turn x y]) -> Game x y -> [QualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> [Turn x y]
forall x y. Game x y -> [Turn x y]
Model.Game.listTurnsChronologically (Game x y -> [QualifiedMove x y])
-> Game x y -> [QualifiedMove x y]
forall a b. (a -> b) -> a -> b
$ PGN x y -> Game x y
forall x y. PGN x y -> Game x y
ContextualNotation.PGN.getGame PGN x y
pgn	-- Extract the list of qualified moves defining this game.
	)
 ) [QualifiedMoveTree x y]
initialForest PGNDatabase x y
pgnDatabase where
	mkCompositeIdentifier :: ContextualNotation.PGN.PGN x y -> Name
	mkCompositeIdentifier :: PGN x y -> String
mkCompositeIdentifier	= [String] -> String
unwords ([String] -> String) -> (PGN x y -> [String]) -> PGN x y -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd {-value-} ([(String, String)] -> [String])
-> (PGN x y -> [(String, String)]) -> PGN x y -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGN x y -> [(String, String)]
forall x y. PGN x y -> [(String, String)]
ContextualNotation.PGN.getIdentificationTagPairs

	merge
		:: (Eq x, Eq y)
		=> OnymousResult				-- ^ The name of this move-sequence, & the result.
		-> [Component.QualifiedMove.QualifiedMove x y]	-- ^ A chronological sequence of /qualified move/s.
		-> [QualifiedMoveTree x y]
		-> [QualifiedMoveTree x y]
	merge :: OnymousResult
-> [QualifiedMove x y]
-> [QualifiedMoveTree x y]
-> [QualifiedMoveTree x y]
merge OnymousResult
onymousResult qualifiedMoves :: [QualifiedMove x y]
qualifiedMoves@(QualifiedMove x y
qualifiedMove : [QualifiedMove x y]
remainingQualifiedMoves) [QualifiedMoveTree x y]
forest	= case (QualifiedMoveTree x y -> Bool)
-> [QualifiedMoveTree x y]
-> ([QualifiedMoveTree x y], [QualifiedMoveTree x y])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (
		\Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = (QualifiedMove x y
qualifiedMove', Maybe OnymousResult
_) } -> QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
/= QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove'
	 ) [QualifiedMoveTree x y]
forest of
		([QualifiedMoveTree x y]
unmatchedForest, QualifiedMoveTree x y
matchingTree : [QualifiedMoveTree x y]
remainingForest)	-> [QualifiedMoveTree x y]
unmatchedForest [QualifiedMoveTree x y]
-> [QualifiedMoveTree x y] -> [QualifiedMoveTree x y]
forall a. [a] -> [a] -> [a]
++ (
			if [QualifiedMove x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QualifiedMove x y]
remainingQualifiedMoves	-- i.e. the terminal move in this game.
				then QualifiedMoveTree x y
matchingTree {
					rootLabel :: (QualifiedMove x y, Maybe OnymousResult)
Data.Tree.rootLabel	= (Maybe OnymousResult -> Maybe OnymousResult)
-> (QualifiedMove x y, Maybe OnymousResult)
-> (QualifiedMove x y, Maybe OnymousResult)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (
						Maybe OnymousResult -> Maybe OnymousResult -> Maybe OnymousResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OnymousResult -> Maybe OnymousResult
forall a. a -> Maybe a
Just OnymousResult
onymousResult	-- CAVEAT: in the event of identical move-sequences, arbitrarily preserve the incumbant (whose result may differ if decided by resignation).
					) ((QualifiedMove x y, Maybe OnymousResult)
 -> (QualifiedMove x y, Maybe OnymousResult))
-> (QualifiedMove x y, Maybe OnymousResult)
-> (QualifiedMove x y, Maybe OnymousResult)
forall a b. (a -> b) -> a -> b
$ QualifiedMoveTree x y -> (QualifiedMove x y, Maybe OnymousResult)
forall a. Tree a -> a
Data.Tree.rootLabel QualifiedMoveTree x y
matchingTree
				}
				else QualifiedMoveTree x y
matchingTree {
					subForest :: [QualifiedMoveTree x y]
Data.Tree.subForest	= OnymousResult
-> [QualifiedMove x y]
-> [QualifiedMoveTree x y]
-> [QualifiedMoveTree x y]
forall x y.
(Eq x, Eq y) =>
OnymousResult
-> [QualifiedMove x y]
-> [QualifiedMoveTree x y]
-> [QualifiedMoveTree x y]
merge OnymousResult
onymousResult [QualifiedMove x y]
remainingQualifiedMoves ([QualifiedMoveTree x y] -> [QualifiedMoveTree x y])
-> [QualifiedMoveTree x y] -> [QualifiedMoveTree x y]
forall a b. (a -> b) -> a -> b
$ QualifiedMoveTree x y -> [QualifiedMoveTree x y]
forall a. Tree a -> Forest a
Data.Tree.subForest QualifiedMoveTree x y
matchingTree	-- Recurse.
				}
		 ) QualifiedMoveTree x y
-> [QualifiedMoveTree x y] -> [QualifiedMoveTree x y]
forall a. a -> [a] -> [a]
: [QualifiedMoveTree x y]
remainingForest
		([QualifiedMoveTree x y], [QualifiedMoveTree x y])
_ {-no match-}						-> OnymousResult -> [QualifiedMove x y] -> QualifiedMoveTree x y
forall x y.
OnymousResult -> [QualifiedMove x y] -> QualifiedMoveTree x y
mkLinkedList OnymousResult
onymousResult [QualifiedMove x y]
qualifiedMoves QualifiedMoveTree x y
-> [QualifiedMoveTree x y] -> [QualifiedMoveTree x y]
forall a. a -> [a] -> [a]
: [QualifiedMoveTree x y]
forest
	merge OnymousResult
_ [] [QualifiedMoveTree x y]
forest					= [QualifiedMoveTree x y]
forest

	mkLinkedList :: OnymousResult -> [Component.QualifiedMove.QualifiedMove x y] -> QualifiedMoveTree x y
	mkLinkedList :: OnymousResult -> [QualifiedMove x y] -> QualifiedMoveTree x y
mkLinkedList OnymousResult
onymousResult ~(QualifiedMove x y
qualifiedMove : [QualifiedMove x y]
remainingQualifiedMoves)
		| [QualifiedMove x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [QualifiedMove x y]
remainingQualifiedMoves	= Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
			rootLabel :: (QualifiedMove x y, Maybe OnymousResult)
Data.Tree.rootLabel	= (QualifiedMove x y
qualifiedMove, OnymousResult -> Maybe OnymousResult
forall a. a -> Maybe a
Just OnymousResult
onymousResult),
			subForest :: Forest (QualifiedMove x y, Maybe OnymousResult)
Data.Tree.subForest	= []
		} -- The terminal node.
		| Bool
otherwise	= Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
			rootLabel :: (QualifiedMove x y, Maybe OnymousResult)
Data.Tree.rootLabel	= (QualifiedMove x y
qualifiedMove, Maybe OnymousResult
forall a. Maybe a
Nothing),
			subForest :: Forest (QualifiedMove x y, Maybe OnymousResult)
Data.Tree.subForest	= [OnymousResult -> [QualifiedMove x y] -> QualifiedMoveTree x y
forall x y.
OnymousResult -> [QualifiedMove x y] -> QualifiedMoveTree x y
mkLinkedList OnymousResult
onymousResult [QualifiedMove x y]
remainingQualifiedMoves {-recurse-}]
		}

-- | Constructor.
fromPGNDatabase :: (Eq x, Eq y) => ContextualNotation.PGNDatabase.PGNDatabase x y -> QualifiedMoveForest x y
fromPGNDatabase :: PGNDatabase x y -> QualifiedMoveForest x y
fromPGNDatabase	= (PGNDatabase x y
-> QualifiedMoveForest x y -> QualifiedMoveForest x y
forall x y.
(Eq x, Eq y) =>
PGNDatabase x y
-> QualifiedMoveForest x y -> QualifiedMoveForest x y
`mergePGNDatabase` QualifiedMoveForest x y
forall a. Empty a => a
Property.Empty.empty {-QualifiedMoveForest-})

-- | Find the minimum number of /piece/s in any of the recorded /game/s.
findMinimumPieces :: QualifiedMoveForest x y -> Type.Count.NPieces
findMinimumPieces :: QualifiedMoveForest x y -> Int
findMinimumPieces	= Int -> Forest (QualifiedMove x y, Maybe OnymousResult) -> Int
forall t x y b.
(Ord t, Enum t) =>
t -> Forest (QualifiedMove x y, b) -> t
slave (
	Board Int Int -> Int
forall x y. Board x y -> Int
State.Board.getNPieces (
		Board Int Int
forall a. Default a => a
Data.Default.def	:: State.Board.Board Type.Length.X Type.Length.Y	-- CAVEAT: this assumes the game to which the moves in the forest refer.
	)
 ) (Forest (QualifiedMove x y, Maybe OnymousResult) -> Int)
-> (QualifiedMoveForest x y
    -> Forest (QualifiedMove x y, Maybe OnymousResult))
-> QualifiedMoveForest x y
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMoveForest x y
-> Forest (QualifiedMove x y, Maybe OnymousResult)
forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct where
	slave :: t -> Forest (QualifiedMove x y, b) -> t
slave t
nPieces []	= t
nPieces
	slave t
nPieces Forest (QualifiedMove x y, b)
forest	= [t] -> t
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([t] -> t) -> [t] -> t
forall a b. (a -> b) -> a -> b
$ (Tree (QualifiedMove x y, b) -> t)
-> Forest (QualifiedMove x y, b) -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (
		\Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= (QualifiedMove x y
qualifiedMove, b
_),
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= Forest (QualifiedMove x y, b)
subForest
		} -> t -> Forest (QualifiedMove x y, b) -> t
slave (
			MoveType -> t -> t
forall nPieces. Enum nPieces => MoveType -> nPieces -> nPieces
Attribute.MoveType.nPiecesMutator (QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove) t
nPieces
		) Forest (QualifiedMove x y, b)
subForest	-- Recurse.
	 ) Forest (QualifiedMove x y, b)
forest

-- | Count the number of /game/s & distinct /positions/.
count :: QualifiedMoveForest x y -> (Type.Count.NGames, Type.Count.NPositions)
count :: QualifiedMoveForest x y -> (Int, Int)
count	= [Tree (QualifiedMove x y, Maybe OnymousResult)] -> (Int, Int)
forall a a. [Tree (a, Maybe a)] -> (Int, Int)
slave ([Tree (QualifiedMove x y, Maybe OnymousResult)] -> (Int, Int))
-> (QualifiedMoveForest x y
    -> [Tree (QualifiedMove x y, Maybe OnymousResult)])
-> QualifiedMoveForest x y
-> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMoveForest x y
-> [Tree (QualifiedMove x y, Maybe OnymousResult)]
forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct where
	slave :: [Tree (a, Maybe a)] -> (Int, Int)
slave	= ((Int, Int) -> Tree (a, Maybe a) -> (Int, Int))
-> (Int, Int) -> [Tree (a, Maybe a)] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
		\(Int
nGames, Int
nPositions) Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= (a
_, Maybe a
maybeOnymousResult),
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [Tree (a, Maybe a)]
forest
		} -> let
			acc :: (Int, Int)
acc@(Int
nGames', Int
nPositions')	= (
				(Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nGames) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
					if Maybe a -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe a
maybeOnymousResult
						then Int -> Int
forall a. Enum a => a -> a
succ
						else Int -> Int
forall a. a -> a
id
				) (Int -> Int) -> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nPositions) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ
			 ) ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ [Tree (a, Maybe a)] -> (Int, Int)
slave [Tree (a, Maybe a)]
forest {-recurse-}
		in Int
nGames' Int -> (Int, Int) -> (Int, Int)
`seq` Int
nPositions' Int -> (Int, Int) -> (Int, Int)
`seq` (Int, Int)
acc
	 ) (Int
0, Int
0)

{- |
	* Convert the specified /qualified-move forest/ to a /game-tree/.

	* N.B.: to construct a tree from the specified forest, the default initial /game/ is included at the apex.
-}
toGameTree :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Show	x,
	Show	y
 ) => QualifiedMoveForest x y -> Model.GameTree.GameTree x y
{-# SPECIALISE toGameTree :: QualifiedMoveForest Type.Length.X Type.Length.Y -> Model.GameTree.GameTree Type.Length.X Type.Length.Y #-}
toGameTree :: QualifiedMoveForest x y -> GameTree x y
toGameTree MkQualifiedMoveForest { deconstruct :: forall x y. QualifiedMoveForest x y -> [QualifiedMoveTree x y]
deconstruct = [QualifiedMoveTree x y]
qualifiedMoveForest }	= BareGameTree x y -> GameTree x y
forall x y. BareGameTree x y -> GameTree x y
Model.GameTree.fromBareGameTree Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
	rootLabel :: Game x y
Data.Tree.rootLabel	= Game x y
initialGame,
	subForest :: Forest (Game x y)
Data.Tree.subForest	= (QualifiedMoveTree x y -> BareGameTree x y)
-> [QualifiedMoveTree x y] -> Forest (Game x y)
forall a b. (a -> b) -> [a] -> [b]
map (Game x y -> QualifiedMoveTree x y -> BareGameTree x y
forall x y b.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> Tree (QualifiedMove x y, b) -> Tree (Game x y)
slave Game x y
initialGame) [QualifiedMoveTree x y]
qualifiedMoveForest
} where
	initialGame :: Game x y
initialGame	= Game x y
forall a. Default a => a
Data.Default.def

	slave :: Game x y -> Tree (QualifiedMove x y, b) -> Tree (Game x y)
slave Game x y
game Data.Tree.Node {
		rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= (QualifiedMove x y
qualifiedMove, b
_),
		subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= Forest (QualifiedMove x y, b)
qualifiedMoveForest'
	} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
		rootLabel :: Game x y
Data.Tree.rootLabel	= Game x y
game',
		subForest :: Forest (Game x y)
Data.Tree.subForest	= (Tree (QualifiedMove x y, b) -> Tree (Game x y))
-> Forest (QualifiedMove x y, b) -> Forest (Game x y)
forall a b. (a -> b) -> [a] -> [b]
map (Game x y -> Tree (QualifiedMove x y, b) -> Tree (Game x y)
slave Game x y
game') Forest (QualifiedMove x y, b)
qualifiedMoveForest'	-- Recurse.
	} where
		game' :: Game x y
game'	= QualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Transformation x y
Model.Game.applyQualifiedMove QualifiedMove x y
qualifiedMove Game x y
game