{-
	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.Piece		as Component.Piece
import qualified	BishBosh.Component.QualifiedMove	as Component.QualifiedMove
import qualified	BishBosh.Component.Turn			as Component.Turn
import qualified	BishBosh.ContextualNotation.PGN		as ContextualNotation.PGN
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.Text.ShowList			as Text.ShowList
import qualified	BishBosh.Type.Count			as Type.Count
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	= Data.Tree.Tree (Component.QualifiedMove.QualifiedMove, Maybe OnymousResult)

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

	* 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	= MkQualifiedMoveForest {
	QualifiedMoveForest -> [QualifiedMoveTree]
deconstruct	:: [QualifiedMoveTree]
} deriving (
	QualifiedMoveForest -> QualifiedMoveForest -> Bool
(QualifiedMoveForest -> QualifiedMoveForest -> Bool)
-> (QualifiedMoveForest -> QualifiedMoveForest -> Bool)
-> Eq QualifiedMoveForest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualifiedMoveForest -> QualifiedMoveForest -> Bool
$c/= :: QualifiedMoveForest -> QualifiedMoveForest -> Bool
== :: QualifiedMoveForest -> QualifiedMoveForest -> Bool
$c== :: QualifiedMoveForest -> QualifiedMoveForest -> Bool
Eq,
	Int -> QualifiedMoveForest -> ShowS
[QualifiedMoveForest] -> ShowS
QualifiedMoveForest -> String
(Int -> QualifiedMoveForest -> ShowS)
-> (QualifiedMoveForest -> String)
-> ([QualifiedMoveForest] -> ShowS)
-> Show QualifiedMoveForest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedMoveForest] -> ShowS
$cshowList :: [QualifiedMoveForest] -> ShowS
show :: QualifiedMoveForest -> String
$cshow :: QualifiedMoveForest -> String
showsPrec :: Int -> QualifiedMoveForest -> ShowS
$cshowsPrec :: Int -> QualifiedMoveForest -> ShowS
Show	-- CAVEAT: required by QuickCheck, but shouldn't actually be called.
 )

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

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

instance Notation.MoveNotation.ShowNotation QualifiedMoveForest where
	showsNotation :: MoveNotation -> QualifiedMoveForest -> ShowS
showsNotation MoveNotation
moveNotation MkQualifiedMoveForest { deconstruct :: QualifiedMoveForest -> [QualifiedMoveTree]
deconstruct = [QualifiedMoveTree]
forest }	= String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ ((QualifiedMove, Maybe OnymousResult) -> String)
-> [QualifiedMoveTree] -> String
forall a. (a -> String) -> Forest a -> String
Data.RoseTree.drawForest (
		\(QualifiedMove
qualifiedMove, Maybe OnymousResult
maybeOnymousResult)	-> MoveNotation -> QualifiedMove -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
moveNotation QualifiedMove
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]
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
	:: ContextualNotation.PGNDatabase.PGNDatabase
	-> QualifiedMoveForest
	-> QualifiedMoveForest
mergePGNDatabase :: PGNDatabase -> QualifiedMoveForest -> QualifiedMoveForest
mergePGNDatabase PGNDatabase
pgnDatabase MkQualifiedMoveForest { deconstruct :: QualifiedMoveForest -> [QualifiedMoveTree]
deconstruct = [QualifiedMoveTree]
initialForest }	= [QualifiedMoveTree] -> QualifiedMoveForest
MkQualifiedMoveForest ([QualifiedMoveTree] -> QualifiedMoveForest)
-> [QualifiedMoveTree] -> QualifiedMoveForest
forall a b. (a -> b) -> a -> b
$ (PGN -> [QualifiedMoveTree] -> [QualifiedMoveTree])
-> [QualifiedMoveTree] -> PGNDatabase -> [QualifiedMoveTree]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
	\PGN
pgn -> OnymousResult
-> QualifiedMoveSequence
-> [QualifiedMoveTree]
-> [QualifiedMoveTree]
merge (
		PGN -> String
mkCompositeIdentifier (PGN -> String) -> (PGN -> Result) -> PGN -> 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 -> Maybe GameTerminationReason) -> PGN -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> Maybe GameTerminationReason
Model.Game.getMaybeTerminationReason (Game -> Maybe GameTerminationReason)
-> (PGN -> Game) -> PGN -> Maybe GameTerminationReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGN -> Game
ContextualNotation.PGN.getGame (PGN -> OnymousResult) -> PGN -> OnymousResult
forall a b. (a -> b) -> a -> b
$ PGN
pgn	-- Construct an onymous result.
	) (
		(Turn -> QualifiedMove) -> [Turn] -> QualifiedMoveSequence
forall a b. (a -> b) -> [a] -> [b]
map Turn -> QualifiedMove
Component.Turn.getQualifiedMove ([Turn] -> QualifiedMoveSequence)
-> (Game -> [Turn]) -> Game -> QualifiedMoveSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game -> [Turn]
Model.Game.listTurnsChronologically (Game -> QualifiedMoveSequence) -> Game -> QualifiedMoveSequence
forall a b. (a -> b) -> a -> b
$ PGN -> Game
ContextualNotation.PGN.getGame PGN
pgn	-- Extract the list of qualified moves defining this game.
	)
 ) [QualifiedMoveTree]
initialForest PGNDatabase
pgnDatabase where
	mkCompositeIdentifier :: ContextualNotation.PGN.PGN -> Name
	mkCompositeIdentifier :: PGN -> String
mkCompositeIdentifier	= [String] -> String
unwords ([String] -> String) -> (PGN -> [String]) -> PGN -> 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 -> [(String, String)]) -> PGN -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGN -> [(String, String)]
ContextualNotation.PGN.getIdentificationTagPairs

	merge
		:: OnymousResult					-- ^ The name of this move-sequence, & the result.
		-> Component.QualifiedMove.QualifiedMoveSequence	-- ^ A chronological sequence of /qualified move/s.
		-> [QualifiedMoveTree]
		-> [QualifiedMoveTree]
	merge :: OnymousResult
-> QualifiedMoveSequence
-> [QualifiedMoveTree]
-> [QualifiedMoveTree]
merge OnymousResult
onymousResult qualifiedMoves :: QualifiedMoveSequence
qualifiedMoves@(QualifiedMove
qualifiedMove : QualifiedMoveSequence
remainingQualifiedMoves) [QualifiedMoveTree]
forest	= case (QualifiedMoveTree -> Bool)
-> [QualifiedMoveTree]
-> ([QualifiedMoveTree], [QualifiedMoveTree])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (
		\Data.Tree.Node { rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel = (QualifiedMove
qualifiedMove', Maybe OnymousResult
_) } -> QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove Move -> Move -> Bool
forall a. Eq a => a -> a -> Bool
/= QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove'
	 ) [QualifiedMoveTree]
forest of
		([QualifiedMoveTree]
unmatchedForest, QualifiedMoveTree
matchingTree : [QualifiedMoveTree]
remainingForest)	-> [QualifiedMoveTree]
unmatchedForest [QualifiedMoveTree] -> [QualifiedMoveTree] -> [QualifiedMoveTree]
forall a. [a] -> [a] -> [a]
++ (
			if QualifiedMoveSequence -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null QualifiedMoveSequence
remainingQualifiedMoves	-- i.e. the terminal move in this game.
				then QualifiedMoveTree
matchingTree {
					rootLabel :: (QualifiedMove, Maybe OnymousResult)
Data.Tree.rootLabel	= (Maybe OnymousResult -> Maybe OnymousResult)
-> (QualifiedMove, Maybe OnymousResult)
-> (QualifiedMove, 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, Maybe OnymousResult)
 -> (QualifiedMove, Maybe OnymousResult))
-> (QualifiedMove, Maybe OnymousResult)
-> (QualifiedMove, Maybe OnymousResult)
forall a b. (a -> b) -> a -> b
$ QualifiedMoveTree -> (QualifiedMove, Maybe OnymousResult)
forall a. Tree a -> a
Data.Tree.rootLabel QualifiedMoveTree
matchingTree
				}
				else QualifiedMoveTree
matchingTree {
					subForest :: [QualifiedMoveTree]
Data.Tree.subForest	= OnymousResult
-> QualifiedMoveSequence
-> [QualifiedMoveTree]
-> [QualifiedMoveTree]
merge OnymousResult
onymousResult QualifiedMoveSequence
remainingQualifiedMoves ([QualifiedMoveTree] -> [QualifiedMoveTree])
-> [QualifiedMoveTree] -> [QualifiedMoveTree]
forall a b. (a -> b) -> a -> b
$ QualifiedMoveTree -> [QualifiedMoveTree]
forall a. Tree a -> Forest a
Data.Tree.subForest QualifiedMoveTree
matchingTree	-- Recurse.
				}
		 ) QualifiedMoveTree -> [QualifiedMoveTree] -> [QualifiedMoveTree]
forall a. a -> [a] -> [a]
: [QualifiedMoveTree]
remainingForest
		([QualifiedMoveTree], [QualifiedMoveTree])
_ {-no match-}						-> OnymousResult -> QualifiedMoveSequence -> QualifiedMoveTree
mkLinkedList OnymousResult
onymousResult QualifiedMoveSequence
qualifiedMoves QualifiedMoveTree -> [QualifiedMoveTree] -> [QualifiedMoveTree]
forall a. a -> [a] -> [a]
: [QualifiedMoveTree]
forest
	merge OnymousResult
_ [] [QualifiedMoveTree]
forest					= [QualifiedMoveTree]
forest

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

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

{- |
	* Find the minimum total number of /piece/s in any of the recorded /game/s, in order to determining whether a sample game is too small to converge on anything in the tree.

	* CAVEAT: no attempt is made to partition this total by logical colour, because there's no clear concept of the /minimum/ amongst the pairs discovered at each leaf-node.

	* N.B.: one call also measure other monotonically changing quantities (number of Pawns, number of Castleable Rooks, least advanced Pawn), but this is cheap.
-}
findMinimumPieces :: QualifiedMoveForest -> Type.Count.NPieces
findMinimumPieces :: QualifiedMoveForest -> Int
findMinimumPieces	= Int -> [QualifiedMoveTree] -> Int
slave (
	Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
Component.Piece.nPiecesPerSide	-- CAVEAT: assuming a conventional starting position.
 ) ([QualifiedMoveTree] -> Int)
-> (QualifiedMoveForest -> [QualifiedMoveTree])
-> QualifiedMoveForest
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMoveForest -> [QualifiedMoveTree]
deconstruct where
	slave :: Type.Count.NPieces -> [QualifiedMoveTree] -> Type.Count.NPieces
	slave :: Int -> [QualifiedMoveTree] -> Int
slave Int
nPieces []	= Int
nPieces
	slave Int
nPieces [QualifiedMoveTree]
forest	= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (QualifiedMoveTree -> Int) -> [QualifiedMoveTree] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (
		\Data.Tree.Node {
			rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= (QualifiedMove
qualifiedMove, Maybe OnymousResult
_),
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [QualifiedMoveTree]
subForest
		} -> let
			nPieces' :: Int
nPieces'	= MoveType -> Int -> Int
forall nPieces. Enum nPieces => MoveType -> nPieces -> nPieces
Attribute.MoveType.nPiecesMutator (QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove) Int
nPieces
		in Int
nPieces' Int -> Int -> Int
`seq` Int -> [QualifiedMoveTree] -> Int
slave Int
nPieces' [QualifiedMoveTree]
subForest	-- Recurse.
	 ) [QualifiedMoveTree]
forest

-- | Count the number of /game/s & distinct /positions/.
count :: QualifiedMoveForest -> (Type.Count.NGames, Type.Count.NPositions)
count :: QualifiedMoveForest -> (Int, Int)
count	= [QualifiedMoveTree] -> (Int, Int)
slave ([QualifiedMoveTree] -> (Int, Int))
-> (QualifiedMoveForest -> [QualifiedMoveTree])
-> QualifiedMoveForest
-> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMoveForest -> [QualifiedMoveTree]
deconstruct where
	slave :: [QualifiedMoveTree] -> (Type.Count.NGames, Type.Count.NPositions)
	slave :: [QualifiedMoveTree] -> (Int, Int)
slave	= ((Int, Int) -> QualifiedMoveTree -> (Int, Int))
-> (Int, Int) -> [QualifiedMoveTree] -> (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	= (QualifiedMove
_, Maybe OnymousResult
maybeOnymousResult),
			subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [QualifiedMoveTree]
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 OnymousResult -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe OnymousResult
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
$ [QualifiedMoveTree] -> (Int, Int)
slave [QualifiedMoveTree]
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 :: QualifiedMoveForest -> Model.GameTree.GameTree
toGameTree :: QualifiedMoveForest -> GameTree
toGameTree MkQualifiedMoveForest { deconstruct :: QualifiedMoveForest -> [QualifiedMoveTree]
deconstruct = [QualifiedMoveTree]
qualifiedMoveForest }	= BareGameTree -> GameTree
Model.GameTree.fromBareGameTree Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
	rootLabel :: Game
Data.Tree.rootLabel	= Game
initialGame,
	subForest :: Forest Game
Data.Tree.subForest	= (QualifiedMoveTree -> BareGameTree)
-> [QualifiedMoveTree] -> Forest Game
forall a b. (a -> b) -> [a] -> [b]
map (Game -> QualifiedMoveTree -> BareGameTree
slave Game
initialGame) [QualifiedMoveTree]
qualifiedMoveForest
} where
	initialGame :: Game
initialGame	= Game
forall a. Default a => a
Data.Default.def

	slave :: Model.Game.Game -> QualifiedMoveTree -> Model.GameTree.BareGameTree
	slave :: Game -> QualifiedMoveTree -> BareGameTree
slave Game
game Data.Tree.Node {
		rootLabel :: forall a. Tree a -> a
Data.Tree.rootLabel	= (QualifiedMove
qualifiedMove, Maybe OnymousResult
_),
		subForest :: forall a. Tree a -> Forest a
Data.Tree.subForest	= [QualifiedMoveTree]
qualifiedMoveForest'
	} = Node :: forall a. a -> Forest a -> Tree a
Data.Tree.Node {
		rootLabel :: Game
Data.Tree.rootLabel	= Game
game',
		subForest :: Forest Game
Data.Tree.subForest	= (QualifiedMoveTree -> BareGameTree)
-> [QualifiedMoveTree] -> Forest Game
forall a b. (a -> b) -> [a] -> [b]
map (Game -> QualifiedMoveTree -> BareGameTree
slave Game
game') [QualifiedMoveTree]
qualifiedMoveForest'	-- Recurse.
	} where
		game' :: Game
game'	= QualifiedMove -> Transformation
Model.Game.applyQualifiedMove QualifiedMove
qualifiedMove Game
game