module BishBosh.ContextualNotation.QualifiedMoveForest(
Name,
OnymousResult,
QualifiedMoveForest(
deconstruct
),
showsNames,
findMinimumPieces,
count,
fromPGNDatabase,
toGameTree,
mergePGNDatabase,
) where
import Control.Applicative((<|>))
import Control.Arrow((&&&), (***))
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Component.Move as Component.Move
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.GameTerminationReason as Model.GameTerminationReason
import qualified BishBosh.Model.GameTree as Model.GameTree
import qualified BishBosh.Model.Result as Model.Result
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.State.Board as State.Board
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Types as T
import qualified Control.Arrow
import qualified Data.Default
import qualified Data.List
import qualified Data.Maybe
import qualified Data.Tree
type Name = String
type OnymousResult = (Name, Model.Result.Result)
type QualifiedMoveTree x y = Data.Tree.Tree (Component.QualifiedMove.QualifiedMove x y, Maybe OnymousResult)
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
)
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 []
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
showsNames
:: Maybe Int
-> [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
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
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
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
Model.Result.mkResult Maybe LogicalColour
forall a. Maybe a
Nothing
) GameTerminationReason -> Result
Model.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
) (
(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
)
) [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 ([(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
-> [Component.QualifiedMove.QualifiedMove x y]
-> [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
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
) ((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
}
) QualifiedMoveTree x y
-> [QualifiedMoveTree x y] -> [QualifiedMoveTree x y]
forall a. a -> [a] -> [a]
: [QualifiedMoveTree x y]
remainingForest
([QualifiedMoveTree x y], [QualifiedMoveTree x y])
_ -> 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 = []
}
| 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 ]
}
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 )
findMinimumPieces :: QualifiedMoveForest x y -> Component.Piece.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 T.X T.Y
)
) (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
) Forest (QualifiedMove x y, b)
forest
count :: QualifiedMoveForest x y -> (Model.Game.NGames, Component.Move.NMoves)
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
nMoves) 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
nMoves') = (
(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
nMoves) (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
in Int
nGames' Int -> (Int, Int) -> (Int, Int)
`seq` Int
nMoves' Int -> (Int, Int) -> (Int, Int)
`seq` (Int, Int)
acc
) (Int
0, Int
0)
toGameTree :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => QualifiedMoveForest x y -> Model.GameTree.GameTree x y
{-# SPECIALISE toGameTree :: QualifiedMoveForest T.X T.Y -> Model.GameTree.GameTree T.X T.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'
} 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