{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module BishBosh.Model.Game(
Transformation,
Game(
getNextLogicalColour,
getCastleableRooksByLogicalColour,
getBoard,
getTurnsByLogicalColour,
getMaybeChecked,
getInstancesByPosition,
getAvailableQualifiedMovesByLogicalColour,
getMaybeTerminationReason
),
countPliesAvailableTo,
rollBack,
sortAvailableQualifiedMoves,
findQualifiedMovesAvailableTo,
findQualifiedMovesAvailableToNextPlayer,
listTurns,
listTurnsChronologically,
maybeLastTurn,
validateQualifiedMove,
validateEitherQualifiedMove,
updateIncrementalPositionHash,
mkPosition,
mkGame,
fromBoard,
mkAvailableQualifiedMovesFor,
takeTurn,
applyQualifiedMove,
applyEitherQualifiedMove,
applyEitherQualifiedMoves,
updateTerminationReasonWith,
resign,
isValidQualifiedMove,
isValidEitherQualifiedMove,
isTerminated,
cantConverge,
(=~),
(/~)
) 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.Component.CastlingMove as Component.CastlingMove
import qualified BishBosh.Component.EitherQualifiedMove as Component.EitherQualifiedMove
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.Component.Zobrist as Component.Zobrist
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Notation.PureCoordinate as Notation.PureCoordinate
import qualified BishBosh.Property.Empty as Property.Empty
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.Null as Property.Null
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.Rule.DrawReason as Rule.DrawReason
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.State.CastleableRooksByLogicalColour as State.CastleableRooksByLogicalColour
import qualified BishBosh.State.CoordinatesByRankByLogicalColour as State.CoordinatesByRankByLogicalColour
import qualified BishBosh.State.EnPassantAbscissa as State.EnPassantAbscissa
import qualified BishBosh.State.InstancesByPosition as State.InstancesByPosition
import qualified BishBosh.State.MaybePieceByCoordinates as State.MaybePieceByCoordinates
import qualified BishBosh.State.Position as State.Position
import qualified BishBosh.StateProperty.Censor as StateProperty.Censor
import qualified BishBosh.StateProperty.Mutator as StateProperty.Mutator
import qualified BishBosh.StateProperty.Seeker as StateProperty.Seeker
import qualified BishBosh.State.TurnsByLogicalColour as State.TurnsByLogicalColour
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Crypto as Type.Crypto
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.Bits
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List
import qualified Data.List.Extra
import qualified Data.Map
import qualified Data.Map.Strict
import qualified Data.Maybe
import qualified Data.Ord
import qualified ToolShed.Data.List
infix 4 =~, /~
type InstancesByPosition x y = State.InstancesByPosition.InstancesByPosition (State.Position.Position x y)
type AvailableQualifiedMoves x y = (
Data.Map.Map (Cartesian.Coordinates.Coordinates x y)
) [
(
Cartesian.Coordinates.Coordinates x y,
Attribute.MoveType.MoveType
)
]
sortAvailableQualifiedMoves :: (Ord x, Ord y) => AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
sortAvailableQualifiedMoves :: AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
sortAvailableQualifiedMoves = ([(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map (([(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> (((Coordinates x y, MoveType)
-> (Coordinates x y, MoveType) -> Ordering)
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> ((Coordinates x y, MoveType)
-> (Coordinates x y, MoveType) -> Ordering)
-> AvailableQualifiedMoves x y
-> AvailableQualifiedMoves x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates x y, MoveType)
-> (Coordinates x y, MoveType) -> Ordering)
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((Coordinates x y, MoveType)
-> (Coordinates x y, MoveType) -> Ordering)
-> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> ((Coordinates x y, MoveType)
-> (Coordinates x y, MoveType) -> Ordering)
-> AvailableQualifiedMoves x y
-> AvailableQualifiedMoves x y
forall a b. (a -> b) -> a -> b
$ ((Coordinates x y, MoveType) -> Coordinates x y)
-> (Coordinates x y, MoveType)
-> (Coordinates x y, MoveType)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (Coordinates x y, MoveType) -> Coordinates x y
forall a b. (a, b) -> a
fst
type AvailableQualifiedMovesByLogicalColour x y = Data.Map.Map Attribute.LogicalColour.LogicalColour (AvailableQualifiedMoves x y)
data Game x y = MkGame {
Game x y -> LogicalColour
getNextLogicalColour :: Attribute.LogicalColour.LogicalColour,
Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour :: State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour x,
Game x y -> Board x y
getBoard :: State.Board.Board x y,
Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour :: State.CastleableRooksByLogicalColour.TurnsByLogicalColour x y,
Game x y -> Maybe LogicalColour
getMaybeChecked :: Maybe Attribute.LogicalColour.LogicalColour,
Game x y -> InstancesByPosition x y
getInstancesByPosition :: InstancesByPosition x y,
Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y,
Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason :: Maybe Rule.GameTerminationReason.GameTerminationReason
}
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Eq (Game x y) where
MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition,
getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour,
getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason
} == :: Game x y -> Game x y -> Bool
== MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour',
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour',
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board',
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour',
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked',
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition',
getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour',
getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason'
} = (
LogicalColour
nextLogicalColour,
CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
Board x y
board,
TurnsByLogicalColour x y
turnsByLogicalColour,
Maybe LogicalColour
maybeChecked,
InstancesByPosition x y
instancesByPosition,
(AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
forall x y.
(Ord x, Ord y) =>
AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
sortAvailableQualifiedMoves AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour,
Maybe GameTerminationReason
maybeTerminationReason
) (LogicalColour, CastleableRooksByLogicalColour x, Board x y,
TurnsByLogicalColour x y, Maybe LogicalColour,
InstancesByPosition x y,
AvailableQualifiedMovesByLogicalColour x y,
Maybe GameTerminationReason)
-> (LogicalColour, CastleableRooksByLogicalColour x, Board x y,
TurnsByLogicalColour x y, Maybe LogicalColour,
InstancesByPosition x y,
AvailableQualifiedMovesByLogicalColour x y,
Maybe GameTerminationReason)
-> Bool
forall a. Eq a => a -> a -> Bool
== (
LogicalColour
nextLogicalColour',
CastleableRooksByLogicalColour x
castleableRooksByLogicalColour',
Board x y
board',
TurnsByLogicalColour x y
turnsByLogicalColour',
Maybe LogicalColour
maybeChecked',
InstancesByPosition x y
instancesByPosition',
(AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
forall x y.
(Ord x, Ord y) =>
AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y
sortAvailableQualifiedMoves AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour',
Maybe GameTerminationReason
maybeTerminationReason'
)
instance (
Control.DeepSeq.NFData x,
Control.DeepSeq.NFData y
) => Control.DeepSeq.NFData (Game x y) where
rnf :: Game x y -> ()
rnf MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition,
getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour,
getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason
} = (LogicalColour, CastleableRooksByLogicalColour x, Board x y,
TurnsByLogicalColour x y, Maybe LogicalColour,
InstancesByPosition x y,
AvailableQualifiedMovesByLogicalColour x y,
Maybe GameTerminationReason)
-> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
LogicalColour
nextLogicalColour,
CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
Board x y
board,
TurnsByLogicalColour x y
turnsByLogicalColour,
Maybe LogicalColour
maybeChecked,
InstancesByPosition x y
instancesByPosition,
AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour,
Maybe GameTerminationReason
maybeTerminationReason
)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Show (Game x y) where
showsPrec :: Int -> Game x y -> ShowS
showsPrec Int
precedence MkGame {
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason
} = Int
-> (Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason)
-> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence (
Board x y
board,
TurnsByLogicalColour x y
turnsByLogicalColour,
Maybe GameTerminationReason
maybeTerminationReason
)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Read x,
Read y,
Show x,
Show y
) => Read (Game x y) where
{-# SPECIALISE instance Read (Game Type.Length.X Type.Length.Y) #-}
readsPrec :: Int -> ReadS (Game x y)
readsPrec Int
precedence = (((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)
-> (Game x y, String))
-> [((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)]
-> [(Game x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map (
((Board x y, TurnsByLogicalColour x y, Maybe GameTerminationReason)
-> Game x y)
-> ((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)
-> (Game x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason)
-> Game x y)
-> ((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)
-> (Game x y, String))
-> ((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason)
-> Game x y)
-> ((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)
-> (Game x y, String)
forall a b. (a -> b) -> a -> b
$ \(
Board x y
board,
TurnsByLogicalColour x y
turnsByLogicalColour,
Maybe GameTerminationReason
maybeTerminationReason
) -> let
game :: Game x y
game = (
(LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y)
-> (LogicalColour, CastleableRooksByLogicalColour x)
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame (
TurnsByLogicalColour x y -> LogicalColour
forall turn. TurnsByLogicalColour turn -> LogicalColour
State.TurnsByLogicalColour.inferNextLogicalColour (TurnsByLogicalColour x y -> LogicalColour)
-> (TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x)
-> TurnsByLogicalColour x y
-> (LogicalColour, CastleableRooksByLogicalColour x)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
forall x y.
(Enum x, Enum y, Eq x, Eq y) =>
TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour (TurnsByLogicalColour x y
-> (LogicalColour, CastleableRooksByLogicalColour x))
-> TurnsByLogicalColour x y
-> (LogicalColour, CastleableRooksByLogicalColour x)
forall a b. (a -> b) -> a -> b
$ TurnsByLogicalColour x y
turnsByLogicalColour
) Board x y
board TurnsByLogicalColour x y
turnsByLogicalColour
) {
getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition = Game x y -> InstancesByPosition x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> InstancesByPosition x y
mkInstancesByPosition Game x y
game,
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason
}
in Game x y
game
) ([((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)]
-> [(Game x y, String)])
-> (String
-> [((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)])
-> ReadS (Game x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String
-> [((Board x y, TurnsByLogicalColour x y,
Maybe GameTerminationReason),
String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Data.Default.Default (Game x y) where
{-# SPECIALISE instance Data.Default.Default (Game Type.Length.X Type.Length.Y) #-}
def :: Game x y
def = (
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
Attribute.LogicalColour.White CastleableRooksByLogicalColour x
forall a. Default a => a
Data.Default.def Board x y
forall a. Default a => a
Data.Default.def TurnsByLogicalColour x y
forall a. Default a => a
Data.Default.def
) {
getMaybeChecked :: Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
forall a. Maybe a
Nothing,
getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = [(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList ([(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y)
-> [(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, AvailableQualifiedMoves x y))
-> [LogicalColour]
-> [(LogicalColour, AvailableQualifiedMoves x y)]
forall a b. (a -> b) -> [a] -> [b]
map (
LogicalColour -> LogicalColour
forall a. a -> a
id (LogicalColour -> LogicalColour)
-> (LogicalColour -> AvailableQualifiedMoves x y)
-> LogicalColour
-> (LogicalColour, AvailableQualifiedMoves x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (LogicalColour -> Game x y -> AvailableQualifiedMoves x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
`mkAvailableQualifiedMovesFor` Game x y
forall a. Default a => a
Data.Default.def )
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
}
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Property.ExtendedPositionDescription.ReadsEPD (Game x y) where
{-# SPECIALISE instance Property.ExtendedPositionDescription.ReadsEPD (Game Type.Length.X Type.Length.Y) #-}
readsEPD :: ReadS (Game x y)
readsEPD String
s = [
(
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
nextLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Board x y
board TurnsByLogicalColour x y
turnsByLogicalColour,
String
s4
) |
(Board x y
board, String
s1) <- ReadS (Board x y)
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD String
s,
(LogicalColour
nextLogicalColour, String
s2) <- ReadS LogicalColour
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD String
s1,
(CastleableRooksByLogicalColour x
castleableRooksByLogicalColour, String
s3) <- ReadS (CastleableRooksByLogicalColour x)
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD String
s2,
(TurnsByLogicalColour x y
turnsByLogicalColour, String
s4) <- case ShowS
Data.List.Extra.trimStart String
s3 of
Char
'-' : String
s4' -> [(TurnsByLogicalColour x y
forall a. Empty a => a
Property.Empty.empty , String
s4')]
String
s3' -> (Coordinates x y -> TurnsByLogicalColour x y)
-> (Coordinates x y, String) -> (TurnsByLogicalColour x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
\Coordinates x y
enPassantDestination -> let
opponentsLogicalColour :: LogicalColour
opponentsLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
in [(LogicalColour, [Turn x y])] -> TurnsByLogicalColour x y
forall turn.
Show turn =>
[(LogicalColour, [turn])] -> TurnsByLogicalColour turn
State.TurnsByLogicalColour.fromAssocs [
(
LogicalColour
nextLogicalColour,
[]
), (
LogicalColour
opponentsLogicalColour,
[
QualifiedMove x y -> Rank -> Turn x y
forall x y. QualifiedMove x y -> Rank -> Turn x y
Component.Turn.mkTurn (
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
(Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b. (a -> b) -> a -> b
$ (
(LogicalColour -> Coordinates x y -> Coordinates x y)
-> (LogicalColour, Coordinates x y) -> Coordinates x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LogicalColour -> Coordinates x y -> Coordinates x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat ((LogicalColour, Coordinates x y) -> Coordinates x y)
-> ((LogicalColour, Coordinates x y) -> Coordinates x y)
-> (LogicalColour, Coordinates x y)
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (LogicalColour -> Coordinates x y -> Coordinates x y)
-> (LogicalColour, Coordinates x y) -> Coordinates x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LogicalColour -> Coordinates x y -> Coordinates x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance
) (LogicalColour
opponentsLogicalColour, Coordinates x y
enPassantDestination)
) MoveType
forall a. Default a => a
Data.Default.def
) Rank
Attribute.Rank.Pawn
]
)
]
) ((Coordinates x y, String) -> (TurnsByLogicalColour x y, String))
-> [(Coordinates x y, String)]
-> [(TurnsByLogicalColour x y, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
ReadS (Coordinates x y)
Notation.PureCoordinate.readsCoordinates String
s3'
]
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.ExtendedPositionDescription.ShowsEPD (Game x y) where
showsEPD :: Game x y -> ShowS
showsEPD game :: Game x y
game@MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board
} = ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
Text.ShowList.showsDelimitedList ShowS
Property.ExtendedPositionDescription.showsSeparator ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id [
Board x y -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD Board x y
board,
LogicalColour -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD LogicalColour
nextLogicalColour,
CastleableRooksByLogicalColour x -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
ShowS -> (Turn x y -> ShowS) -> Maybe (Turn x y) -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe ShowS
Property.ExtendedPositionDescription.showsNullField (
\Turn x y
turn -> if LogicalColour -> Turn x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Turn x y -> Bool
Component.Turn.isPawnDoubleAdvance (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) Turn x y
turn
then MoveNotation -> Coordinates x y -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
Notation.MoveNotation.showsNotation MoveNotation
forall a. Default a => a
Data.Default.def (Coordinates x y -> ShowS)
-> (QualifiedMove x y -> Coordinates x y)
-> QualifiedMove x y
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour Transformation x y
-> (QualifiedMove x y -> Coordinates x y)
-> QualifiedMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Coordinates x y)
-> (QualifiedMove x y -> Move x y)
-> QualifiedMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> ShowS) -> QualifiedMove x y -> ShowS
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
else ShowS
Property.ExtendedPositionDescription.showsNullField
) (Maybe (Turn x y) -> ShowS) -> Maybe (Turn x y) -> ShowS
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game
]
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Property.ForsythEdwards.ReadsFEN (Game x y) where
{-# SPECIALISE instance Property.ForsythEdwards.ReadsFEN (Game Type.Length.X Type.Length.Y) #-}
readsFEN :: ReadS (Game x y)
readsFEN String
s = [
(Game x y
game, String
s3) |
(Game x y
game, String
s1) <- ReadS (Game x y)
forall a. ReadsEPD a => ReadS a
Property.ExtendedPositionDescription.readsEPD String
s,
(Int
_halfMoveClock, String
s2) <- ReadS Int
forall a. Read a => ReadS a
reads String
s1 :: [(Int, String)],
(Int
_fullMoveCounter, String
s3) <- ReadS Int
forall a. Read a => ReadS a
reads String
s2 :: [(Int, String)]
]
instance (
Enum x,
Enum y,
Ord x,
Ord y
) => Property.ForsythEdwards.ShowsFEN (Game x y) where
showsFEN :: Game x y -> ShowS
showsFEN game :: Game x y
game@MkGame {
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition
} = ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
Text.ShowList.showsDelimitedList ShowS
Property.ExtendedPositionDescription.showsSeparator ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id [
Game x y -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD Game x y
game,
Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ InstancesByPosition x y -> Int
forall position. InstancesByPosition position -> Int
State.InstancesByPosition.countConsecutiveRepeatablePlies InstancesByPosition x y
instancesByPosition,
Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> ([Turn x y] -> Int) -> [Turn x y] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> ([Turn x y] -> Int) -> [Turn x y] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Turn x y] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Turn x y] -> ShowS) -> [Turn x y] -> ShowS
forall a b. (a -> b) -> a -> b
$ LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
Attribute.LogicalColour.Black TurnsByLogicalColour x y
turnsByLogicalColour
]
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Property.Empty.Empty (Game x y) where
{-# SPECIALISE instance Property.Empty.Empty (Game Type.Length.X Type.Length.Y) #-}
empty :: Game x y
empty = Game x y
forall a. Default a => a
Data.Default.def
instance Property.Null.Null (Game x y) where
isNull :: Game x y -> Bool
isNull MkGame { getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour } = TurnsByLogicalColour x y -> Bool
forall a. Null a => a -> Bool
Property.Null.isNull TurnsByLogicalColour x y
turnsByLogicalColour
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Property.Reflectable.ReflectableOnX (Game x y) where
{-# SPECIALISE instance Property.Reflectable.ReflectableOnX (Game Type.Length.X Type.Length.Y) #-}
reflectOnX :: Game x y -> Game x y
reflectOnX MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition,
getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason
} = (
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame (
LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
) (
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX CastleableRooksByLogicalColour x
castleableRooksByLogicalColour
) (
Board x y -> Board x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Board x y
board
) (
TurnsByLogicalColour x y -> TurnsByLogicalColour x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX TurnsByLogicalColour x y
turnsByLogicalColour
)
) {
getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y -> InstancesByPosition x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX InstancesByPosition x y
instancesByPosition,
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = (GameTerminationReason -> GameTerminationReason)
-> Maybe GameTerminationReason -> Maybe GameTerminationReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GameTerminationReason -> GameTerminationReason
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Maybe GameTerminationReason
maybeTerminationReason
}
instance (Data.Array.IArray.Ix x, Enum x, Enum y, Ord y) => Component.Zobrist.Hashable2D Game x y where
{-# SPECIALISE instance Component.Zobrist.Hashable2D Game Type.Length.X Type.Length.Y #-}
listRandoms2D :: Game x y -> Zobrist x y positionHash -> [positionHash]
listRandoms2D game :: Game x y
game@MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board
} Zobrist x y positionHash
zobrist = (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
nextLogicalColour
then (Zobrist x y positionHash -> positionHash
forall x y positionHash. Zobrist x y positionHash -> positionHash
Component.Zobrist.getRandomForBlacksMove Zobrist x y positionHash
zobrist positionHash -> [positionHash] -> [positionHash]
forall a. a -> [a] -> [a]
:)
else [positionHash] -> [positionHash]
forall a. a -> a
id
) ([positionHash] -> [positionHash])
-> ([positionHash] -> [positionHash])
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([positionHash] -> [positionHash])
-> (EnPassantAbscissa x -> [positionHash] -> [positionHash])
-> Maybe (EnPassantAbscissa x)
-> [positionHash]
-> [positionHash]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [positionHash] -> [positionHash]
forall a. a -> a
id (
[positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
(++) ([positionHash] -> [positionHash] -> [positionHash])
-> (EnPassantAbscissa x -> [positionHash])
-> EnPassantAbscissa x
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnPassantAbscissa x -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
`Component.Zobrist.listRandoms1D` Zobrist x y positionHash
zobrist)
) (
Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game Maybe (Turn x y)
-> (Turn x y -> Maybe (EnPassantAbscissa x))
-> Maybe (EnPassantAbscissa x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
State.EnPassantAbscissa.mkMaybeEnPassantAbscissa LogicalColour
nextLogicalColour (
Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
)
) ([positionHash] -> [positionHash])
-> [positionHash] -> [positionHash]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour x
-> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms1D CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Zobrist x y positionHash
zobrist [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++ Board x y -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> * -> *) x y positionHash.
Hashable2D hashable x y =>
hashable x y -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms2D Board x y
board Zobrist x y positionHash
zobrist
mkGame :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> Attribute.LogicalColour.LogicalColour
-> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour x
-> State.Board.Board x y
-> State.CastleableRooksByLogicalColour.TurnsByLogicalColour x y
-> Game x y
{-# SPECIALISE mkGame :: Attribute.LogicalColour.LogicalColour -> State.CastleableRooksByLogicalColour.CastleableRooksByLogicalColour Type.Length.X -> State.Board.Board Type.Length.X Type.Length.Y -> State.CastleableRooksByLogicalColour.TurnsByLogicalColour Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y #-}
mkGame :: LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
nextLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Board x y
board TurnsByLogicalColour x y
turnsByLogicalColour
| Bool -> Bool
not (Bool -> Bool)
-> (CoordinatesByRankByLogicalColour x y -> Bool)
-> CoordinatesByRankByLogicalColour x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordinatesByRankByLogicalColour x y -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasBothKings (CoordinatesByRankByLogicalColour x y -> Bool)
-> CoordinatesByRankByLogicalColour x y -> Bool
forall a b. (a -> b) -> a -> b
$ Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
board = Exception -> Game x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game x y)
-> (String -> Exception) -> String -> Game x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.mkGame:\tboth Kings must exist; " (String -> Game x y) -> String -> Game x y
forall a b. (a -> b) -> a -> b
$ Board x y -> ShowS
forall a. Show a => a -> ShowS
shows Board x y
board String
"."
| LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
State.Board.isKingChecked (
LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
) Board x y
board = Exception -> Game x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game x y)
-> (String -> Exception) -> String -> Game x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.mkGame:\tthe player who last moved, is still checked; " (String -> Game x y) -> String -> Game x y
forall a b. (a -> b) -> a -> b
$ Board x y -> ShowS
forall a. Show a => a -> ShowS
shows Board x y
board String
"."
| Bool
otherwise = Game x y
game
where
game :: Game x y
game = MkGame :: forall x y.
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Maybe LogicalColour
-> InstancesByPosition x y
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe GameTerminationReason
-> Game x y
MkGame {
getNextLogicalColour :: LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getMaybeChecked :: Maybe LogicalColour
getMaybeChecked = (LogicalColour -> Bool) -> [LogicalColour] -> Maybe LogicalColour
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition = Position x y -> InstancesByPosition x y
forall position. position -> InstancesByPosition position
State.InstancesByPosition.mkSingleton (Position x y -> InstancesByPosition x y)
-> Position x y -> InstancesByPosition x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game,
getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = [(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
(LogicalColour
logicalColour, LogicalColour -> Game x y -> AvailableQualifiedMoves x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
logicalColour Game x y
game) |
LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
Game x y -> Maybe LogicalColour
forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked Game x y
game Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour
],
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = Game x y -> Maybe GameTerminationReason
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> Maybe GameTerminationReason
inferMaybeTerminationReason Game x y
game
}
fromBoard :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => State.Board.Board x y -> Game x y
{-# SPECIALISE fromBoard :: State.Board.Board Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y #-}
fromBoard :: Board x y -> Game x y
fromBoard Board x y
board = LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour
-> CastleableRooksByLogicalColour x
-> Board x y
-> TurnsByLogicalColour x y
-> Game x y
mkGame LogicalColour
Attribute.LogicalColour.White (
Board x y -> CastleableRooksByLogicalColour x
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x) =>
Board x y -> CastleableRooksByLogicalColour x
State.CastleableRooksByLogicalColour.fromBoard Board x y
board
) Board x y
board TurnsByLogicalColour x y
forall a. Empty a => a
Property.Empty.empty
listTurns :: Game x y -> [Component.Turn.Turn x y]
listTurns :: Game x y -> [Turn x y]
listTurns MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour
} = ([Turn x y] -> [Turn x y] -> [Turn x y])
-> ([Turn x y], [Turn x y]) -> [Turn x y]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Turn x y] -> [Turn x y] -> [Turn x y]
forall a. [a] -> [a] -> [a]
ToolShed.Data.List.interleave (([Turn x y], [Turn x y]) -> [Turn x y])
-> ([Turn x y], [Turn x y]) -> [Turn x y]
forall a b. (a -> b) -> a -> b
$ (
LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour) (TurnsByLogicalColour x y -> [Turn x y])
-> (TurnsByLogicalColour x y -> [Turn x y])
-> TurnsByLogicalColour x y
-> ([Turn x y], [Turn x y])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
nextLogicalColour
) TurnsByLogicalColour x y
turnsByLogicalColour
listTurnsChronologically :: Game x y -> [Component.Turn.Turn x y]
listTurnsChronologically :: Game x y -> [Turn x y]
listTurnsChronologically = [Turn x y] -> [Turn x y]
forall a. [a] -> [a]
reverse ([Turn x y] -> [Turn x y])
-> (Game x y -> [Turn x y]) -> Game x y -> [Turn 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]
listTurns
maybeLastTurn :: Game x y -> Maybe (Component.Turn.Turn x y)
maybeLastTurn :: Game x y -> Maybe (Turn x y)
maybeLastTurn MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour
} = [Turn x y] -> Maybe (Turn x y)
forall a. [a] -> Maybe a
Data.Maybe.listToMaybe ([Turn x y] -> Maybe (Turn x y)) -> [Turn x y] -> Maybe (Turn x y)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (
LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
) TurnsByLogicalColour x y
turnsByLogicalColour
findAvailableCastlingMoves :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Attribute.LogicalColour.LogicalColour -> Game x y -> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE findAvailableCastlingMoves :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
findAvailableCastlingMoves :: LogicalColour -> Game x y -> [QualifiedMove x y]
findAvailableCastlingMoves LogicalColour
logicalColour MkGame {
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked
}
| Just LogicalColour
checkedLogicalColour <- Maybe LogicalColour
maybeChecked
, LogicalColour
checkedLogicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour = []
| Just [x]
rooksStartingXs <- LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
forall x.
LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
State.CastleableRooksByLogicalColour.locateForLogicalColour LogicalColour
logicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour = [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
castlingKingsMove (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ CastlingMove x y -> MoveType
forall x y. CastlingMove x y -> MoveType
Component.CastlingMove.getMoveType CastlingMove x y
castlingMove |
x
x <- [x]
rooksStartingXs,
CastlingMove x y
castlingMove <- LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
Component.CastlingMove.getCastlingMoves LogicalColour
logicalColour,
let castlingRooksSource :: Coordinates x y
castlingRooksSource = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y) -> Move x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove CastlingMove x y
castlingMove,
Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
castlingRooksSource x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
x,
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isClear (
LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour
) Coordinates x y
castlingRooksSource (MaybePieceByCoordinates x y -> Bool)
-> MaybePieceByCoordinates x y -> Bool
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board,
let castlingKingsMove :: Move x y
castlingKingsMove = CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove CastlingMove x y
castlingMove,
(Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
[(Coordinates x y, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates x y, Rank)] -> Bool)
-> (Coordinates x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Board x y -> [(Coordinates x y, Rank)])
-> Board x y -> [(Coordinates x y, Rank)]
forall a b. (a -> b) -> a -> b
$ Board x y
board) ((Board x y -> [(Coordinates x y, Rank)])
-> [(Coordinates x y, Rank)])
-> (Coordinates x y -> Board x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> [(Coordinates x y, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour
) ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Move x y -> [Coordinates x y]
Component.Move.interpolate Move x y
castlingKingsMove
]
| Bool
otherwise = []
listMaybePromotionRanks
:: (Enum y, Eq y)
=> Cartesian.Coordinates.Coordinates x y
-> Component.Piece.Piece
-> [Maybe Attribute.Rank.Rank]
{-# INLINE listMaybePromotionRanks #-}
listMaybePromotionRanks :: Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination Piece
piece
| Coordinates x y -> Piece -> Bool
forall y x. (Enum y, Eq y) => Coordinates x y -> Piece -> Bool
Component.Piece.isPawnPromotion Coordinates x y
destination Piece
piece = (Rank -> Maybe Rank) -> [Rank] -> [Maybe Rank]
forall a b. (a -> b) -> [a] -> [b]
map Rank -> Maybe Rank
forall a. a -> Maybe a
Just [Rank]
Attribute.Rank.promotionProspects
| Bool
otherwise = [Maybe Rank
forall a. Maybe a
Nothing]
type Transformation x y = Game x y -> Game x y
takeTurn :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Component.Turn.Turn x y -> Transformation x y
{-# SPECIALISE takeTurn :: Component.Turn.Turn Type.Length.X Type.Length.Y -> Transformation Type.Length.X Type.Length.Y #-}
takeTurn :: Turn x y -> Transformation x y
takeTurn Turn x y
turn game :: Game x y
game@MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition,
getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour
} = Bool -> Transformation x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game
) Game x y
game' where
((Move x y
move, MoveType
moveType), Rank
sourceRank) = (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove x y -> (Move x y, MoveType))
-> (Turn x y -> QualifiedMove x y)
-> Turn x y
-> (Move x y, MoveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove (Turn x y -> (Move x y, MoveType))
-> (Turn x y -> Rank) -> Turn x y -> ((Move x y, MoveType), Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank (Turn x y -> ((Move x y, MoveType), Rank))
-> Turn x y -> ((Move x y, MoveType), Rank)
forall a b. (a -> b) -> a -> b
$ Turn x y
turn
(Coordinates x y
source, Coordinates x y
destination) = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (Move x y -> Coordinates x y)
-> Move x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> (Coordinates x y, Coordinates x y))
-> Move x y -> (Coordinates x y, Coordinates x y)
forall a b. (a -> b) -> a -> b
$ Move x y
move
opponentsLogicalColour :: Attribute.LogicalColour.LogicalColour
opponentsLogicalColour :: LogicalColour
opponentsLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
inferredRooksMove :: Move x y
inferredRooksMove = Move x y
-> (CastlingMove x y -> Move x y)
-> Maybe (CastlingMove x y)
-> Move x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Exception -> Move x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Move x y)
-> (String -> Exception) -> String -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.takeTurn:\tfailed to find any Rook's move corresponding to " (String -> Move x y) -> String -> Move x y
forall a b. (a -> b) -> a -> b
$ (Move x y, MoveType) -> ShowS
forall a. Show a => a -> ShowS
shows (Move x y
move, MoveType
moveType) String
"."
) CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove (Maybe (CastlingMove x y) -> Move x y)
-> ([CastlingMove x y] -> Maybe (CastlingMove x y))
-> [CastlingMove x y]
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CastlingMove x y -> Bool)
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
(Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
== Move x y
move) (Move x y -> Bool)
-> (CastlingMove x y -> Move x y) -> CastlingMove x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove
) ([CastlingMove x y] -> Move x y) -> [CastlingMove x y] -> Move x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
Component.CastlingMove.getCastlingMoves LogicalColour
nextLogicalColour
board' :: Board x y
board' = (
if MoveType -> Bool
Attribute.MoveType.isCastle MoveType
moveType
then Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
inferredRooksMove (Maybe MoveType -> Transformation x y)
-> Maybe MoveType -> Transformation x y
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
forall a. Default a => a
Data.Default.def
else Transformation x y
forall a. a -> a
id
) Transformation x y -> Transformation x y
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board x y
board
maybePieceByCoordinates' :: MaybePieceByCoordinates x y
maybePieceByCoordinates' = Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board'
game' :: Game x y
game' = Game x y
game {
getNextLogicalColour :: LogicalColour
getNextLogicalColour = LogicalColour
opponentsLogicalColour,
getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = LogicalColour -> Turn x y -> Transformation x
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Turn x y -> Transformation x
State.CastleableRooksByLogicalColour.takeTurn LogicalColour
nextLogicalColour Turn x y
turn CastleableRooksByLogicalColour x
castleableRooksByLogicalColour,
getBoard :: Board x y
getBoard = Board x y
board',
getTurnsByLogicalColour :: TurnsByLogicalColour x y
getTurnsByLogicalColour = LogicalColour -> Turn x y -> Transformation (Turn x y)
forall turn. LogicalColour -> turn -> Transformation turn
State.TurnsByLogicalColour.prepend LogicalColour
nextLogicalColour Turn x y
turn TurnsByLogicalColour x y
turnsByLogicalColour,
getMaybeChecked :: Maybe LogicalColour
getMaybeChecked = (LogicalColour -> Bool) -> [LogicalColour] -> Maybe LogicalColour
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board') [LogicalColour
opponentsLogicalColour],
getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition = Bool -> Position x y -> Transformation (Position x y)
forall position.
Ord position =>
Bool -> position -> Transformation position
State.InstancesByPosition.insertPosition (Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.getIsRepeatableMove Turn x y
turn) (Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game') InstancesByPosition x y
instancesByPosition,
getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = let
moveEndpoints :: [Coordinates x y]
moveEndpoints = (
case MoveType
moveType of
Attribute.MoveType.Castle Bool
_ -> [Coordinates x y] -> [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a] -> [a]
(++) [
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
inferredRooksMove,
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
inferredRooksMove
]
MoveType
Attribute.MoveType.EnPassant -> (LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
nextLogicalColour Coordinates x y
destination Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. a -> [a] -> [a]
:)
MoveType
_ -> [Coordinates x y] -> [Coordinates x y]
forall a. a -> a
id
) [Coordinates x y
source, Coordinates x y
destination]
kingsByCoordinates :: [(Coordinates x y, Piece)]
kingsByCoordinates = (LogicalColour -> (Coordinates x y, Piece))
-> [LogicalColour] -> [(Coordinates x y, Piece)]
forall a b. (a -> b) -> [a] -> [b]
map (
(LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
forall x y.
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
`State.CoordinatesByRankByLogicalColour.getKingsCoordinates` Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
board') (LogicalColour -> Coordinates x y)
-> (LogicalColour -> Piece)
-> LogicalColour
-> (Coordinates x y, Piece)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Piece
Component.Piece.mkKing
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
([(Coordinates x y, Piece)]
affected, [(Coordinates x y, Piece)]
affected') = (
[(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. Eq a => [a] -> [a]
Data.List.nub ([(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)])
-> ([(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)])
-> [(Coordinates x y, Piece)]
-> [(Coordinates x y, Piece)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (
Coordinates x y
destination,
LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
nextLogicalColour (Rank -> Piece) -> (Maybe Rank -> Rank) -> Maybe Rank -> Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rank -> Maybe Rank -> Rank
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Rank
sourceRank (Maybe Rank -> Piece) -> Maybe Rank -> Piece
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank MoveType
moveType
) ([(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)])
-> ([(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)])
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. Eq a => [a] -> [a]
Data.List.nub
) (([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)]))
-> ([(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)]))
-> [(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Coordinates x y, Piece) -> Bool)
-> [(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition (
(LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
nextLogicalColour) (LogicalColour -> Bool)
-> ((Coordinates x y, Piece) -> LogicalColour)
-> (Coordinates x y, Piece)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour (Piece -> LogicalColour)
-> ((Coordinates x y, Piece) -> Piece)
-> (Coordinates x y, Piece)
-> LogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y, Piece) -> Piece
forall a b. (a, b) -> b
snd
) ([(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)]))
-> ([(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)])
-> [(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
if LogicalColour -> Turn x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Turn x y -> Bool
Component.Turn.isPawnDoubleAdvance LogicalColour
nextLogicalColour Turn x y
turn
then [(Coordinates x y, Piece)]
-> [(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. [a] -> [a] -> [a]
(++) [
(Coordinates x y
pawnCoordinates, Piece
oppositePiece) |
let oppositePiece :: Piece
oppositePiece = LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
opponentsLogicalColour Rank
sourceRank,
Coordinates x y
pawnCoordinates <- Coordinates x y -> [Coordinates x y]
forall x y. (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.getAdjacents Coordinates x y
destination,
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
pawnCoordinates (Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board) Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
oppositePiece
]
else [(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. a -> a
id
) ([(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)]))
-> [(Coordinates x y, Piece)]
-> ([(Coordinates x y, Piece)], [(Coordinates x y, Piece)])
forall a b. (a -> b) -> a -> b
$ [(Coordinates x y, Piece)]
kingsByCoordinates [(Coordinates x y, Piece)]
-> [(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. [a] -> [a] -> [a]
++ [
(Coordinates x y
knightsCoordinates, LogicalColour -> Piece
Component.Piece.mkKnight LogicalColour
knightsColour) |
LogicalColour
knightsColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
Coordinates x y
moveEndpoint <- [Coordinates x y]
moveEndpoints,
Coordinates x y
knightsCoordinates <- LogicalColour -> Coordinates x y -> Board x y -> [Coordinates x y]
forall (seeker :: * -> * -> *) x y.
Seeker seeker x y =>
LogicalColour -> Coordinates x y -> seeker x y -> [Coordinates x y]
StateProperty.Seeker.findProximateKnights LogicalColour
knightsColour Coordinates x y
moveEndpoint Board x y
board'
] [(Coordinates x y, Piece)]
-> [(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. [a] -> [a] -> [a]
++ (
if Rank
sourceRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.King
then [
(Coordinates x y
blockingCoordinates, Piece
blockingPiece) |
(Coordinates x y
kingsCoordinates, Piece
_) <- [(Coordinates x y, Piece)]
kingsByCoordinates,
Direction
direction <- [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
(Coordinates x y
blockingCoordinates, Piece
blockingPiece) <- Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)])
-> Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a b. (a -> b) -> a -> b
$ Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (Coordinates x y, Piece)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (LocatedPiece x y)
State.MaybePieceByCoordinates.findBlockingPiece Direction
direction Coordinates x y
kingsCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates'
]
else [
(Coordinates x y
blockingCoordinates, Piece
blockingPiece) |
(Coordinates x y
kingsCoordinates, Piece
_) <- [(Coordinates x y, Piece)]
kingsByCoordinates,
Coordinates x y
moveEndpoint <- [Coordinates x y]
moveEndpoints,
Direction
direction <- Maybe Direction -> [Direction]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe Direction -> [Direction]) -> Maybe Direction -> [Direction]
forall a b. (a -> b) -> a -> b
$ Vector Int -> Maybe Direction
forall distance.
(Num distance, Ord distance) =>
Vector distance -> Maybe Direction
Cartesian.Vector.toMaybeDirection (
Coordinates x y -> Coordinates x y -> Vector Int
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Coordinates x y -> Coordinates x y -> Vector distance
Cartesian.Vector.measureDistance Coordinates x y
kingsCoordinates Coordinates x y
moveEndpoint :: Cartesian.Vector.VectorInt
),
let findBlockingPieceFrom :: Coordinates x y -> Maybe (Coordinates x y, Piece)
findBlockingPieceFrom Coordinates x y
coordinates = Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (Coordinates x y, Piece)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (LocatedPiece x y)
State.MaybePieceByCoordinates.findBlockingPiece Direction
direction Coordinates x y
coordinates MaybePieceByCoordinates x y
maybePieceByCoordinates',
(Coordinates x y
blockingCoordinates, Piece
blockingPiece) <- Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)])
-> Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a b. (a -> b) -> a -> b
$ (
\pair :: (Coordinates x y, Piece)
pair@(Coordinates x y
coordinates, Piece
_) -> if Coordinates x y
coordinates Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
destination
then (Coordinates x y, Piece) -> Maybe (Coordinates x y, Piece)
forall a. a -> Maybe a
Just (Coordinates x y, Piece)
pair
else if Vector Int -> Maybe Direction
forall distance.
(Num distance, Ord distance) =>
Vector distance -> Maybe Direction
Cartesian.Vector.toMaybeDirection (
Coordinates x y -> Coordinates x y -> Vector Int
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Coordinates x y -> Coordinates x y -> Vector distance
Cartesian.Vector.measureDistance Coordinates x y
kingsCoordinates Coordinates x y
source :: Cartesian.Vector.VectorInt
) Maybe Direction -> Maybe Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
direction
then Maybe (Coordinates x y, Piece)
forall a. Maybe a
Nothing
else Coordinates x y -> Maybe (Coordinates x y, Piece)
findBlockingPieceFrom Coordinates x y
coordinates
) ((Coordinates x y, Piece) -> Maybe (Coordinates x y, Piece))
-> Maybe (Coordinates x y, Piece) -> Maybe (Coordinates x y, Piece)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Coordinates x y -> Maybe (Coordinates x y, Piece)
findBlockingPieceFrom Coordinates x y
kingsCoordinates
]
) [(Coordinates x y, Piece)]
-> [(Coordinates x y, Piece)] -> [(Coordinates x y, Piece)]
forall a. [a] -> [a] -> [a]
++ [
(Coordinates x y
coordinates, Piece
affectedPiece) |
Coordinates x y
moveEndpoint <- [Coordinates x y]
moveEndpoints,
Direction
direction <- [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
(Coordinates x y
coordinates, Piece
affectedPiece) <- Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)])
-> Maybe (Coordinates x y, Piece) -> [(Coordinates x y, Piece)]
forall a b. (a -> b) -> a -> b
$ Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (Coordinates x y, Piece)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Direction
-> Coordinates x y
-> MaybePieceByCoordinates x y
-> Maybe (LocatedPiece x y)
State.MaybePieceByCoordinates.findBlockingPiece Direction
direction Coordinates x y
moveEndpoint MaybePieceByCoordinates x y
maybePieceByCoordinates',
Coordinates x y
coordinates Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
destination,
Bool -> Bool
not (Bool -> Bool) -> ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ (Piece -> Bool
Component.Piece.isKnight (Piece -> Bool) -> (Piece -> Bool) -> Piece -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Piece -> Bool
Component.Piece.isKing) Piece
affectedPiece,
Coordinates x y -> Coordinates x y -> Piece -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
Coordinates x y -> Coordinates x y -> Piece -> Bool
Component.Piece.canMoveBetween Coordinates x y
coordinates Coordinates x y
moveEndpoint Piece
affectedPiece
]
insertMovesFrom :: Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> [(Coordinates x y, Piece)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
insertMovesFrom = ((Coordinates x y, Piece)
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> [(Coordinates x y, Piece)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Coordinates x y, Piece)
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> [(Coordinates x y, Piece)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> ((Coordinates x y, Piece)
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> [(Coordinates x y, Piece)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall a b. (a -> b) -> a -> b
$ \(Coordinates x y
source', Piece
piece') -> let
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece'
isSafeDestination :: Coordinates x y -> Bool
isSafeDestination Coordinates x y
destination' = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Move x y -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Move x y -> Board x y -> Bool
State.Board.exposesKing LogicalColour
logicalColour (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source' Coordinates x y
destination') Board x y
board'
in case [
(Coordinates x y
destination', MoveType
Attribute.MoveType.EnPassant) |
LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
logicalColour Coordinates x y
source',
Piece -> Bool
Component.Piece.isPawn Piece
piece',
Coordinates x y
destination' <- Coordinates x y -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
Component.Piece.findAttackDestinations Coordinates x y
source' Piece
piece',
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isVacant Coordinates x y
destination' MaybePieceByCoordinates x y
maybePieceByCoordinates',
(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (Coordinates x y -> (Bool, Bool)) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Piece
piece')) (Maybe Piece -> Bool)
-> (Coordinates x y -> Maybe Piece) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
`State.MaybePieceByCoordinates.dereference` MaybePieceByCoordinates x y
maybePieceByCoordinates'
) (Coordinates x y -> Bool)
-> (Coordinates x y -> Bool) -> Coordinates x y -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
== Move x y
move) (Move x y -> Bool)
-> (Coordinates x y -> Move x y) -> Coordinates x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove (LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates x y
destination')
) (Coordinates x y -> Bool) -> Coordinates x y -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates x y
destination',
Coordinates x y -> Bool
isSafeDestination Coordinates x y
destination'
] [(Coordinates x y, MoveType)]
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)]
forall a. [a] -> [a] -> [a]
++ [
(
Coordinates x y
destination',
Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank
) |
(Coordinates x y
destination', Maybe Rank
maybeTakenRank) <- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
source' Piece
piece' MaybePieceByCoordinates x y
maybePieceByCoordinates',
Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King,
Coordinates x y -> Bool
isSafeDestination Coordinates x y
destination',
Maybe Rank
maybePromotionRank <- Coordinates x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination' Piece
piece'
] of
[] -> Coordinates x y
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall k a. Ord k => k -> Map k a -> Map k a
Data.Map.delete Coordinates x y
source'
[(Coordinates x y, MoveType)]
qualifiedDestinations -> Coordinates x y
-> [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Data.Map.insert Coordinates x y
source' [(Coordinates x y, MoveType)]
qualifiedDestinations
insertCastlingMoves :: LogicalColour
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
insertCastlingMoves LogicalColour
logicalColour = case LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
findAvailableCastlingMoves LogicalColour
logicalColour Game x y
game' of
[] -> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall a. a -> a
id
[QualifiedMove x y]
validCastlingMoves -> (Coordinates x y
-> [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Coordinates x y, [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
([(Coordinates x y, MoveType)]
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> Coordinates x y
-> [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.insertWith [(Coordinates x y, MoveType)]
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)]
forall a. [a] -> [a] -> [a]
(++)
) ((Coordinates x y, [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Coordinates x y, [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall a b. (a -> b) -> a -> b
$ (
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> ([QualifiedMove x y] -> Move x y)
-> [QualifiedMove x y]
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> ([QualifiedMove x y] -> QualifiedMove x y)
-> [QualifiedMove x y]
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove x y] -> QualifiedMove x y
forall a. [a] -> a
head ([QualifiedMove x y] -> Coordinates x y)
-> ([QualifiedMove x y] -> [(Coordinates x y, MoveType)])
-> [QualifiedMove x y]
-> (Coordinates x y, [(Coordinates x y, MoveType)])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (QualifiedMove x y -> (Coordinates x y, MoveType))
-> [QualifiedMove x y] -> [(Coordinates x y, MoveType)]
forall a b. (a -> b) -> [a] -> [b]
map (
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Coordinates x y)
-> (QualifiedMove x y -> Move x y)
-> QualifiedMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Coordinates x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Coordinates x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType
)
) [QualifiedMove x y]
validCastlingMoves
in (
\AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour' -> (
case (LogicalColour -> AvailableQualifiedMovesByLogicalColour x y -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Data.Map.member LogicalColour
opponentsLogicalColour AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour', Maybe LogicalColour -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust (Maybe LogicalColour -> Bool) -> Maybe LogicalColour -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe LogicalColour
forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked Game x y
game') of
(Bool
True, Bool
True) -> LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Ord k => k -> Map k a -> Map k a
Data.Map.delete LogicalColour
opponentsLogicalColour
(Bool
True, Bool
_) -> (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Data.Map.adjust (
LogicalColour
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
insertCastlingMoves LogicalColour
opponentsLogicalColour (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> [(Coordinates x y, Piece)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
`insertMovesFrom` [(Coordinates x y, Piece)]
affected'
) (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
if MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType
then Coordinates x y
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall k a. Ord k => k -> Map k a -> Map k a
Data.Map.delete (Coordinates x y
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Coordinates x y
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
nextLogicalColour Coordinates x y
destination
else Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall a. a -> a
id
) (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall k a. Ord k => k -> Map k a -> Map k a
Data.Map.delete Coordinates x y
destination
) LogicalColour
opponentsLogicalColour
(Bool
_, Bool
True) -> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall a. a -> a
id
(Bool, Bool)
_ -> LogicalColour
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Ord k => k -> a -> Map k a -> Map k a
Data.Map.insert LogicalColour
opponentsLogicalColour (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y)
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ LogicalColour
-> Game x y -> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
opponentsLogicalColour Game x y
game'
) AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour'
) (AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y)
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ (
if Bool
-> (Map (Coordinates x y) [(Coordinates x y, MoveType)] -> Bool)
-> Maybe (Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True (
\Map (Coordinates x y) [(Coordinates x y, MoveType)]
availableQualifiedMoves -> Rank
sourceRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.King Bool -> Bool -> Bool
|| Bool -> (Turn x y -> Bool) -> Maybe (Turn x y) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
LogicalColour -> Turn x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Turn x y -> Bool
Component.Turn.isPawnDoubleAdvance LogicalColour
opponentsLogicalColour
) (
Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game
) Bool -> Bool -> Bool
&& ([(Coordinates x y, MoveType)] -> Bool)
-> Map (Coordinates x y) [(Coordinates x y, MoveType)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.Foldable.any (
((Coordinates x y, MoveType) -> Bool)
-> [(Coordinates x y, MoveType)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((Coordinates x y, MoveType) -> Bool)
-> [(Coordinates x y, MoveType)] -> Bool)
-> ((Coordinates x y, MoveType) -> Bool)
-> [(Coordinates x y, MoveType)]
-> Bool
forall a b. (a -> b) -> a -> b
$ MoveType -> Bool
Attribute.MoveType.isEnPassant (MoveType -> Bool)
-> ((Coordinates x y, MoveType) -> MoveType)
-> (Coordinates x y, MoveType)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y, MoveType) -> MoveType
forall a b. (a, b) -> b
snd
) Map (Coordinates x y) [(Coordinates x y, MoveType)]
availableQualifiedMoves
) (Maybe (Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Bool)
-> Maybe (Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe (Map (Coordinates x y) [(Coordinates x y, MoveType)])
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup LogicalColour
nextLogicalColour AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour
then LogicalColour
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Ord k => k -> a -> Map k a -> Map k a
Data.Map.insert LogicalColour
nextLogicalColour (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y)
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ LogicalColour
-> Game x y -> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
nextLogicalColour Game x y
game'
else (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Data.Map.adjust (
LogicalColour
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
insertCastlingMoves LogicalColour
nextLogicalColour (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> [(Coordinates x y, Piece)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
`insertMovesFrom` [(Coordinates x y, Piece)]
affected
) (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> (Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)])
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
-> Map (Coordinates x y) [(Coordinates x y, MoveType)]
forall k a. Ord k => k -> Map k a -> Map k a
Data.Map.delete Coordinates x y
source
) LogicalColour
nextLogicalColour
) AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour,
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = Game x y -> Maybe GameTerminationReason
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> Maybe GameTerminationReason
inferMaybeTerminationReason Game x y
game'
}
applyQualifiedMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Component.QualifiedMove.QualifiedMove x y -> Transformation x y
{-# SPECIALISE applyQualifiedMove :: Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y -> Transformation Type.Length.X Type.Length.Y #-}
applyQualifiedMove :: QualifiedMove x y -> Transformation x y
applyQualifiedMove QualifiedMove x y
qualifiedMove game :: Game x y
game@MkGame { getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board }
| Just Piece
piece <- Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference (Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move) (MaybePieceByCoordinates x y -> Maybe Piece)
-> MaybePieceByCoordinates x y -> Maybe Piece
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
= Turn x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Turn x y -> Transformation x y
takeTurn (QualifiedMove x y -> Rank -> Turn x y
forall x y. QualifiedMove x y -> Rank -> Turn x y
Component.Turn.mkTurn QualifiedMove x y
qualifiedMove (Rank -> Turn x y) -> Rank -> Turn x y
forall a b. (a -> b) -> a -> b
$ Piece -> Rank
Component.Piece.getRank Piece
piece) Game x y
game
| Bool
otherwise = Exception -> Game x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Game x y)
-> (String -> Exception) -> String -> Game x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Model.Game.applyQualifiedMove:\tthere isn't a piece at the source of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> ShowS
forall a. Show a => a -> ShowS
shows Move x y
move ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> Game x y) -> String -> Game x y
forall a b. (a -> b) -> a -> b
$ Game x y -> ShowS
forall a. Show a => a -> ShowS
shows Game x y
game String
"."
where
move :: Move x y
move = QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove
applyEitherQualifiedMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Component.EitherQualifiedMove.EitherQualifiedMove x y -> Transformation x y
{-# SPECIALISE applyEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y -> Transformation Type.Length.X Type.Length.Y #-}
applyEitherQualifiedMove :: EitherQualifiedMove x y -> Transformation x y
applyEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove game :: Game x y
game@MkGame { getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board } = 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
applyQualifiedMove (
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
move (MoveType -> QualifiedMove x y)
-> (Either (Maybe Rank) MoveType -> MoveType)
-> Either (Maybe Rank) MoveType
-> QualifiedMove x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
((MaybePieceByCoordinates x y -> MoveType)
-> MaybePieceByCoordinates x y -> MoveType
forall a b. (a -> b) -> a -> b
$ Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board) ((MaybePieceByCoordinates x y -> MoveType) -> MoveType)
-> (Maybe Rank -> MaybePieceByCoordinates x y -> MoveType)
-> Maybe Rank
-> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
State.MaybePieceByCoordinates.inferMoveType Move x y
move (Maybe Rank -> MoveType)
-> (MoveType -> MoveType)
-> Either (Maybe Rank) MoveType
-> MoveType
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| MoveType -> MoveType
forall a. a -> a
id
) (Either (Maybe Rank) MoveType -> QualifiedMove x y)
-> Either (Maybe Rank) MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
forall x y. EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
Component.EitherQualifiedMove.getPromotionRankOrMoveType EitherQualifiedMove x y
eitherQualifiedMove
) Game x y
game where
move :: Move x y
move = EitherQualifiedMove x y -> Move x y
forall x y. EitherQualifiedMove x y -> Move x y
Component.EitherQualifiedMove.getMove EitherQualifiedMove x y
eitherQualifiedMove
applyEitherQualifiedMoves :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> (a -> Either String (Component.EitherQualifiedMove.EitherQualifiedMove x y))
-> Game x y
-> [a]
-> Either (a, String) (Game x y)
{-# SPECIALISE applyEitherQualifiedMoves :: (a -> Either String (Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y)) -> Game Type.Length.X Type.Length.Y -> [a] -> Either (a, String) (Game Type.Length.X Type.Length.Y) #-}
applyEitherQualifiedMoves :: (a -> Either String (EitherQualifiedMove x y))
-> Game x y -> [a] -> Either (a, String) (Game x y)
applyEitherQualifiedMoves a -> Either String (EitherQualifiedMove x y)
moveConstructor = (Either (a, String) (Game x y)
-> a -> Either (a, String) (Game x y))
-> Either (a, String) (Game x y)
-> [a]
-> Either (a, String) (Game x y)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (
\Either (a, String) (Game x y)
eitherGame a
datum -> Either (a, String) (Game x y)
eitherGame Either (a, String) (Game x y)
-> (Game x y -> Either (a, String) (Game x y))
-> Either (a, String) (Game x y)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (
\Game x y
game -> (a, String) -> Either (a, String) (Game x y)
forall a b. a -> Either a b
Left ((a, String) -> Either (a, String) (Game x y))
-> (String -> (a, String))
-> String
-> Either (a, String) (Game x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
datum (String -> Either (a, String) (Game x y))
-> (EitherQualifiedMove x y -> Either (a, String) (Game x y))
-> Either String (EitherQualifiedMove x y)
-> Either (a, String) (Game x y)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (
\EitherQualifiedMove x y
eitherQualifiedMove -> Either (a, String) (Game x y)
-> (String -> Either (a, String) (Game x y))
-> Maybe String
-> Either (a, String) (Game x y)
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Game x y -> Either (a, String) (Game x y)
forall a b. b -> Either a b
Right (Game x y -> Either (a, String) (Game x y))
-> Game x y -> Either (a, String) (Game x y)
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
EitherQualifiedMove x y -> Transformation x y
applyEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove Game x y
game
) (
\String
errorMessage -> (a, String) -> Either (a, String) (Game x y)
forall a b. a -> Either a b
Left (
a
datum,
String -> ShowS
showString String
"board" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Board x y -> ShowS
forall a. Show a => a -> ShowS
shows (Game x y -> Board x y
forall x y. Game x y -> Board x y
getBoard Game x y
game) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" (" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
errorMessage String
")"
)
) (Maybe String -> Either (a, String) (Game x y))
-> Maybe String -> Either (a, String) (Game x y)
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
EitherQualifiedMove x y -> Game x y -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove Game x y
game
) (Either String (EitherQualifiedMove x y)
-> Either (a, String) (Game x y))
-> Either String (EitherQualifiedMove x y)
-> Either (a, String) (Game x y)
forall a b. (a -> b) -> a -> b
$ a -> Either String (EitherQualifiedMove x y)
moveConstructor a
datum
)
) (Either (a, String) (Game x y)
-> [a] -> Either (a, String) (Game x y))
-> (Game x y -> Either (a, String) (Game x y))
-> Game x y
-> [a]
-> Either (a, String) (Game x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Either (a, String) (Game x y)
forall a b. b -> Either a b
Right
validateQualifiedMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> Component.QualifiedMove.QualifiedMove x y
-> Game x y
-> Maybe String
{-# SPECIALISE validateQualifiedMove :: Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Maybe String #-}
validateQualifiedMove :: QualifiedMove x y -> Game x y -> Maybe String
validateQualifiedMove QualifiedMove x y
qualifiedMove game :: Game x y
game@MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked,
getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason
} = Bool -> Maybe String -> Maybe String
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
CoordinatesByRankByLogicalColour x y -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasBothKings (
Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
board
) Bool -> Bool -> Bool
&& Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== (LogicalColour -> Bool) -> [LogicalColour] -> Maybe LogicalColour
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
) (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (GameTerminationReason -> Maybe String)
-> Maybe GameTerminationReason
-> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Maybe String
-> (Piece -> Maybe String) -> Maybe Piece -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
String -> Maybe String
forall a. a -> Maybe a
Just String
"there isn't a piece at the specified source-coordinates"
) (
\Piece
sourcePiece -> let
sourceLogicalColour :: LogicalColour
sourceLogicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
sourcePiece
in Bool -> [(Bool, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Bool
True ([(Bool, String)] -> Maybe String)
-> [(Bool, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ ([(Bool, String)] -> [(Bool, String)])
-> (Piece -> [(Bool, String)] -> [(Bool, String)])
-> Maybe Piece
-> [(Bool, String)]
-> [(Bool, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [(Bool, String)] -> [(Bool, String)]
forall a. a -> a
id (
\Piece
destinationPiece -> [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
(++) [
(
Piece -> Bool
Component.Piece.isKing Piece
destinationPiece,
String -> ShowS
showString String
"a '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
destinationPiece String
"' can't be taken"
), (
Piece -> Piece -> Bool
Component.Piece.isFriend Piece
destinationPiece Piece
sourcePiece,
String -> ShowS
showString String
"your own '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
destinationPiece String
"' occupies the requested destination"
)
]
) Maybe Piece
maybeDestinationPiece [
(
LogicalColour
sourceLogicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
nextLogicalColour,
String -> ShowS
showString String
"it's " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows LogicalColour
nextLogicalColour ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"'s turn, but the referenced piece is " ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ LogicalColour -> String
forall a. Show a => a -> String
show LogicalColour
sourceLogicalColour
), (
MoveType -> Bool
Attribute.MoveType.isPromotion MoveType
moveType Bool -> Bool -> Bool
&& Bool -> Bool
not (Piece -> Bool
Component.Piece.isPawn Piece
sourcePiece),
String -> ShowS
showString String
"only a '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows (LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
sourceLogicalColour) String
"' can be promoted"
)
] [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ ((Bool, String) -> (Bool, String))
-> [(Bool, String)] -> [(Bool, String)]
forall a b. (a -> b) -> [a] -> [b]
map (
ShowS -> (Bool, String) -> (Bool, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (ShowS -> (Bool, String) -> (Bool, String))
-> ShowS -> (Bool, String) -> (Bool, String)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"regarding moving your '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
sourcePiece ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"', "
) (
(
case Piece -> Rank
Component.Piece.getRank Piece
sourcePiece of
Rank
Attribute.Rank.Pawn
| Coordinates x y
destination Coordinates x y -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Coordinates x y -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
Component.Piece.findAttackDestinations Coordinates x y
source Piece
sourcePiece -> [(Bool, String)]
-> (Piece -> [(Bool, String)]) -> Maybe Piece -> [(Bool, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
let
opponentsCoordinates :: Coordinates x y
opponentsCoordinates = LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
sourceLogicalColour Coordinates x y
destination
opponentsPawn :: Piece
opponentsPawn = Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Piece
sourcePiece
in [
(
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
sourceLogicalColour Coordinates x y
source,
String -> ShowS
showString String
"one can't take a '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
opponentsPawn String
"' en-passant, from this rank"
), (
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isOccupied Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates,
String -> ShowS
showString String
"taking a '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
opponentsPawn String
"' en-passant, requires a move to a vacant square"
), (
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
opponentsCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
/= Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
opponentsPawn,
String -> ShowS
forall a. Show a => a -> ShowS
shows String
"en-passant" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" requires a '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
opponentsPawn String
"' to be taken"
), (
Bool -> (Turn x y -> Bool) -> Maybe (Turn x y) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
True (
(
Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove (LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
sourceLogicalColour Coordinates x y
destination) Coordinates x y
opponentsCoordinates
) (Move x y -> Bool) -> (Turn x y -> Move x y) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
) (Maybe (Turn x y) -> Bool) -> Maybe (Turn x y) -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game,
String -> ShowS
showString String
"a '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows Piece
opponentsPawn String
"' can only be taken en-passant, immediately after it has advanced two squares"
)
]
) (
[(Bool, String)] -> Piece -> [(Bool, String)]
forall a b. a -> b -> a
const []
) Maybe Piece
maybeDestinationPiece
| Bool
otherwise -> (
Vector Int -> Int
forall distance. Vector distance -> distance
Cartesian.Vector.getXDistance Vector Int
distance Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0,
String
"it may only have a sideways component during attack"
) (Bool, String) -> [(Bool, String)] -> [(Bool, String)]
forall a. a -> [a] -> [a]
: (
case (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
sourceLogicalColour
then Int -> Int
forall a. Num a => a -> a
negate
else Int -> Int
forall a. a -> a
id
) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall distance. Vector distance -> distance
Cartesian.Vector.getYDistance Vector Int
distance of
Int
1 -> [(Bool, String)] -> [(Bool, String)]
forall a. a -> a
id
Int
2 -> [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
(++) [
(
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
sourceLogicalColour Coordinates x y
source,
String
"it only has the option to advance two squares on its first move"
), (
Bool
isObstructed,
String
"an obstruction can't be jumped"
)
]
Int
nSquares -> (:) (
Bool
True,
if Int
nSquares Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then String
"it must advance"
else if Int
nSquares Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then String -> ShowS
showString String
"it can't advance " ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
nSquares String
" squares"
else String
"it can't retreat"
)
) [
(
Maybe Piece -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe Piece
maybeDestinationPiece,
String
"an advance must be to a vacant square"
)
]
Rank
Attribute.Rank.Rook -> [
(
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel Move x y
move,
String
"only moves parallel to the edges of the board are permissible"
), (
Bool
isObstructed,
String
"an obstruction can't be jumped"
)
]
Rank
Attribute.Rank.Knight -> [
(
Vector Int
distance Vector Int -> [Vector Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Vector Int]
forall distance. Num distance => [Vector distance]
Cartesian.Vector.attackVectorsForKnight,
String
"the jump must be to the opposite corner of a 3 x 2 rectangle"
)
]
Rank
Attribute.Rank.Bishop -> [
(
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal Move x y
move,
String
"only moves diagonal to the edges of the board are permissible"
), (
Bool
isObstructed,
String
"an obstruction can't be jumped"
)
]
Rank
Attribute.Rank.Queen -> [
(
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight Move x y
move,
String
"only straight moves are permissible"
), (
Bool
isObstructed,
String
"an obstruction can't be jumped"
)
]
Rank
Attribute.Rank.King
| Vector Int
distance Vector Int -> [Vector Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vector Int]
forall distance. (Eq distance, Num distance) => [Vector distance]
Cartesian.Vector.attackVectorsForKing -> []
| Bool
otherwise -> [(Bool, String)]
-> (CastlingMove x y -> [(Bool, String)])
-> Maybe (CastlingMove x y)
-> [(Bool, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [
(
Bool
True,
String
"it can only castle (move two squares left or right from its starting position), or move one square in any direction"
)
] (
(
\Coordinates x y
rooksSource -> [
(
Bool -> Bool
not (Bool -> Bool)
-> (CastleableRooksByLogicalColour x -> Bool)
-> CastleableRooksByLogicalColour x
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> CastleableRooksByLogicalColour x -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> CastleableRooksByLogicalColour x -> Bool
State.CastleableRooksByLogicalColour.canCastleWith LogicalColour
sourceLogicalColour Coordinates x y
rooksSource (CastleableRooksByLogicalColour x -> Bool)
-> CastleableRooksByLogicalColour x -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> CastleableRooksByLogicalColour x
forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour Game x y
game,
String -> ShowS
showString String
"it has either already castled or lost the right to castle with the implied '" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Piece -> ShowS
forall a. Show a => a -> ShowS
shows (LogicalColour -> Piece
Component.Piece.mkRook LogicalColour
sourceLogicalColour) String
"'"
), (
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isObstructed Coordinates x y
source Coordinates x y
rooksSource MaybePieceByCoordinates x y
maybePieceByCoordinates,
String
"it can't castle through an obstruction"
)
]
) (Coordinates x y -> [(Bool, String)])
-> (CastlingMove x y -> Coordinates x y)
-> CastlingMove x y
-> [(Bool, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (CastlingMove x y -> Move x y)
-> CastlingMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove
) (
(CastlingMove x y -> Bool)
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
(Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
== Move x y
move) (Move x y -> Bool)
-> (CastlingMove x y -> Move x y) -> CastlingMove x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove
) ([CastlingMove x y] -> Maybe (CastlingMove x y))
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
Component.CastlingMove.getCastlingMoves LogicalColour
sourceLogicalColour
) [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ [
(
Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
sourceLogicalColour,
String
"it can't castle out of check"
), (
Bool -> Bool
not (Bool -> Bool)
-> ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
[(Coordinates x y, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates x y, Rank)] -> Bool)
-> (Coordinates x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Board x y -> [(Coordinates x y, Rank)])
-> Board x y -> [(Coordinates x y, Rank)]
forall a b. (a -> b) -> a -> b
$ Board x y
board) ((Board x y -> [(Coordinates x y, Rank)])
-> [(Coordinates x y, Rank)])
-> (Coordinates x y -> Board x y -> [(Coordinates x y, Rank)])
-> Coordinates x y
-> [(Coordinates x y, Rank)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
sourceLogicalColour
) ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Move x y -> [Coordinates x y]
Component.Move.interpolate Move x y
move,
String
"it can't castle through check"
)
]
) [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ [
ShowS -> (Bool, String) -> (Bool, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (
if Piece -> Bool
Component.Piece.isKing Piece
sourcePiece
then String -> ShowS
showString String
"it"
else String -> ShowS
showString String
"your '" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. Show a => a -> ShowS
shows (LogicalColour -> Piece
Component.Piece.mkKing LogicalColour
sourceLogicalColour) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\''
) ((Bool, String) -> (Bool, String))
-> (Bool, String) -> (Bool, String)
forall a b. (a -> b) -> a -> b
$ if Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
sourceLogicalColour
then (
LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
State.Board.isKingChecked LogicalColour
sourceLogicalColour (Board x y -> Bool) -> Board x y -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board x y
board,
String
" remains checked"
)
else (
LogicalColour -> Move x y -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Move x y -> Board x y -> Bool
State.Board.exposesKing LogicalColour
sourceLogicalColour Move x y
move Board x y
board,
String
" would become exposed"
)
]
)
) (Maybe Piece -> Maybe String) -> Maybe Piece -> Maybe String
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
source MaybePieceByCoordinates x y
maybePieceByCoordinates
) (
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (GameTerminationReason -> String)
-> GameTerminationReason
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameTerminationReason -> String
forall a. Show a => a -> String
show
) Maybe GameTerminationReason
maybeTerminationReason where
(Move x y
move, MoveType
moveType) = QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ QualifiedMove x y
qualifiedMove
(Coordinates x y
source, Coordinates x y
destination) = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (Move x y -> Coordinates x y)
-> Move x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> (Coordinates x y, Coordinates x y))
-> Move x y -> (Coordinates x y, Coordinates x y)
forall a b. (a -> b) -> a -> b
$ Move x y
move
maybePieceByCoordinates :: MaybePieceByCoordinates x y
maybePieceByCoordinates = Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
maybeDestinationPiece :: Maybe Piece
maybeDestinationPiece = Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates
distance :: Cartesian.Vector.VectorInt
distance :: Vector Int
distance = Move x y -> Vector Int
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
Component.Move.measureDistance Move x y
move
isObstructed :: Bool
isObstructed :: Bool
isObstructed = Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isObstructed Coordinates x y
source Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates
validateEitherQualifiedMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> Component.EitherQualifiedMove.EitherQualifiedMove x y
-> Game x y
-> Maybe String
{-# SPECIALISE validateEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Maybe String #-}
validateEitherQualifiedMove :: EitherQualifiedMove x y -> Game x y -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove game :: Game x y
game@MkGame { getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board }
| Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isVacant (
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
) MaybePieceByCoordinates x y
maybePieceByCoordinates = String -> Maybe String
forall a. a -> Maybe a
Just String
"there isn't a piece at the specified source-coordinates"
| Right MoveType
moveType <- Either (Maybe Rank) MoveType
promotionRankOrMoveType
, MoveType
moveType MoveType -> MoveType -> Bool
forall a. Eq a => a -> a -> Bool
/= MoveType
inferredMoveType = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"the implied " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
Attribute.MoveType.tag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveType -> ShowS
forall a. Show a => a -> ShowS
shows MoveType
moveType ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" /= " (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ MoveType -> String
forall a. Show a => a -> String
show MoveType
inferredMoveType
| Bool
otherwise = QualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Game x y -> Maybe String
validateQualifiedMove (Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
move MoveType
inferredMoveType) Game x y
game
where
(Move x y
move, Either (Maybe Rank) MoveType
promotionRankOrMoveType) = EitherQualifiedMove x y -> Move x y
forall x y. EitherQualifiedMove x y -> Move x y
Component.EitherQualifiedMove.getMove (EitherQualifiedMove x y -> Move x y)
-> (EitherQualifiedMove x y -> Either (Maybe Rank) MoveType)
-> EitherQualifiedMove x y
-> (Move x y, Either (Maybe Rank) MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
forall x y. EitherQualifiedMove x y -> Either (Maybe Rank) MoveType
Component.EitherQualifiedMove.getPromotionRankOrMoveType (EitherQualifiedMove x y
-> (Move x y, Either (Maybe Rank) MoveType))
-> EitherQualifiedMove x y
-> (Move x y, Either (Maybe Rank) MoveType)
forall a b. (a -> b) -> a -> b
$ EitherQualifiedMove x y
eitherQualifiedMove
maybePieceByCoordinates :: MaybePieceByCoordinates x y
maybePieceByCoordinates = Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board
inferredMoveType :: Attribute.MoveType.MoveType
inferredMoveType :: MoveType
inferredMoveType = Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe Rank -> MaybePieceByCoordinates x y -> MoveType
State.MaybePieceByCoordinates.inferMoveType Move x y
move (
Maybe Rank -> Maybe Rank
forall a. a -> a
id (Maybe Rank -> Maybe Rank)
-> (MoveType -> Maybe Rank)
-> Either (Maybe Rank) MoveType
-> Maybe Rank
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank (Either (Maybe Rank) MoveType -> Maybe Rank)
-> Either (Maybe Rank) MoveType -> Maybe Rank
forall a b. (a -> b) -> a -> b
$ Either (Maybe Rank) MoveType
promotionRankOrMoveType
) MaybePieceByCoordinates x y
maybePieceByCoordinates
isValidQualifiedMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Component.QualifiedMove.QualifiedMove x y -> Game x y -> Bool
{-# SPECIALISE isValidQualifiedMove :: Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Bool #-}
isValidQualifiedMove :: QualifiedMove x y -> Game x y -> Bool
isValidQualifiedMove QualifiedMove x y
qualifiedMove = Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool)
-> (Game x y -> Maybe String) -> Game x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
QualifiedMove x y -> Game x y -> Maybe String
validateQualifiedMove QualifiedMove x y
qualifiedMove
isValidEitherQualifiedMove :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Component.EitherQualifiedMove.EitherQualifiedMove x y -> Game x y -> Bool
{-# SPECIALISE isValidEitherQualifiedMove :: Component.EitherQualifiedMove.EitherQualifiedMove Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Bool #-}
isValidEitherQualifiedMove :: EitherQualifiedMove x y -> Game x y -> Bool
isValidEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove = Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool)
-> (Game x y -> Maybe String) -> Game x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherQualifiedMove x y -> Game x y -> Maybe String
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
EitherQualifiedMove x y -> Game x y -> Maybe String
validateEitherQualifiedMove EitherQualifiedMove x y
eitherQualifiedMove
rollBack :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Game x y -> [(Game x y, Component.Turn.Turn x y)]
{-# SPECIALISE rollBack :: Game Type.Length.X Type.Length.Y -> [(Game Type.Length.X Type.Length.Y, Component.Turn.Turn Type.Length.X Type.Length.Y)] #-}
rollBack :: Game x y -> [(Game x y, Turn x y)]
rollBack = (Game x y -> Maybe ((Game x y, Turn x y), Game x y))
-> Game x y -> [(Game x y, Turn x y)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
Data.List.unfoldr (
\game :: Game x y
game@MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition
} -> let
previousColour :: LogicalColour
previousColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
nextLogicalColour
in case LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
previousColour TurnsByLogicalColour x y
turnsByLogicalColour of
Turn x y
turn : [Turn x y]
previousTurns -> let
(Move x y
move, MoveType
moveType) = (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
destination :: Coordinates x y
destination = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move
game' :: Game x y
game'@MkGame {
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board',
getTurnsByLogicalColour :: forall x y. Game x y -> TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
turnsByLogicalColour',
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked'
} = Game x y
game {
getNextLogicalColour :: LogicalColour
getNextLogicalColour = LogicalColour
previousColour,
getCastleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
forall x y.
(Enum x, Enum y, Eq x, Eq y) =>
TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
State.CastleableRooksByLogicalColour.fromTurnsByLogicalColour TurnsByLogicalColour x y
turnsByLogicalColour',
getMaybeChecked :: Maybe LogicalColour
getMaybeChecked = (LogicalColour -> Bool) -> [LogicalColour] -> Maybe LogicalColour
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (LogicalColour -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Board x y -> Bool
`State.Board.isKingChecked` Board x y
board') [LogicalColour
previousColour],
getBoard :: Board x y
getBoard = (
case MoveType
moveType of
Attribute.MoveType.Castle Bool
isShort -> Move x y -> Maybe MoveType -> Board x y -> Board x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece (
(Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b. (a -> b) -> a -> b
$ (
(x -> x) -> Transformation x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX (
if Bool
isShort then x -> x
forall a. Enum a => a -> a
pred else x -> x
forall a. Enum a => a -> a
succ
) Transformation x y
-> Transformation x y
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (x -> x) -> Transformation x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX (
x -> x -> x
forall a b. a -> b -> a
const (x -> x -> x) -> x -> x -> x
forall a b. (a -> b) -> a -> b
$ if Bool
isShort then x
forall x. Enum x => x
Cartesian.Abscissa.xMax else x
forall x. Enum x => x
Cartesian.Abscissa.xMin
)
) Coordinates x y
destination
) (Maybe MoveType -> Board x y -> Board x y)
-> Maybe MoveType -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
forall a. Default a => a
Data.Default.def
MoveType
Attribute.MoveType.EnPassant -> Piece -> Coordinates x y -> Board x y -> Board x y
forall (mutator :: * -> * -> *) x y.
Mutator mutator x y =>
Piece -> Coordinates x y -> mutator x y -> mutator x y
StateProperty.Mutator.placePiece (
LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
nextLogicalColour
) (Coordinates x y -> Board x y -> Board x y)
-> Coordinates x y -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour Coordinates x y
destination
MoveType
_
| MoveType -> Bool
Attribute.MoveType.isPromotion MoveType
moveType -> Piece -> Coordinates x y -> Board x y -> Board x y
forall (mutator :: * -> * -> *) x y.
Mutator mutator x y =>
Piece -> Coordinates x y -> mutator x y -> mutator x y
StateProperty.Mutator.placePiece (
LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
previousColour
) (Coordinates x y -> Board x y -> Board x y)
-> Coordinates x y -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
| Bool
otherwise -> Board x y -> Board x y
forall a. a -> a
id
) (Board x y -> Board x y)
-> (Board x y -> Board x y) -> Board x y -> Board x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Board x y -> Board x y)
-> (Rank -> Board x y -> Board x y)
-> Maybe Rank
-> Board x y
-> Board x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Board x y -> Board x y
forall a. a -> a
id (
(Piece -> Coordinates x y -> Board x y -> Board x y
forall (mutator :: * -> * -> *) x y.
Mutator mutator x y =>
Piece -> Coordinates x y -> mutator x y -> mutator x y
`StateProperty.Mutator.placePiece` Coordinates x y
destination) (Piece -> Board x y -> Board x y)
-> (Rank -> Piece) -> Rank -> Board x y -> Board x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
nextLogicalColour
) (
MoveType -> Maybe Rank
Attribute.MoveType.getMaybeExplicitlyTakenRank MoveType
moveType
) (Board x y -> Board x y) -> Board x y -> Board x y
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Board x y -> Board x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece (Move x y -> Move x y
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Move x y
move) Maybe MoveType
forall a. Maybe a
Nothing Board x y
board,
getTurnsByLogicalColour :: TurnsByLogicalColour x y
getTurnsByLogicalColour = TurnsByLogicalColour x y
-> [(LogicalColour, [Turn x y])] -> TurnsByLogicalColour x y
forall turn.
TurnsByLogicalColour turn
-> [(LogicalColour, [turn])] -> TurnsByLogicalColour turn
State.TurnsByLogicalColour.update TurnsByLogicalColour x y
turnsByLogicalColour [(LogicalColour
previousColour, [Turn x y]
previousTurns)],
getInstancesByPosition :: InstancesByPosition x y
getInstancesByPosition = if Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.getIsRepeatableMove Turn x y
turn
then Position x y -> Transformation (Position x y)
forall position.
Ord position =>
position -> Transformation position
State.InstancesByPosition.deletePosition (Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game) InstancesByPosition x y
instancesByPosition
else Game x y -> InstancesByPosition x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> InstancesByPosition x y
mkInstancesByPosition Game x y
game',
getAvailableQualifiedMovesByLogicalColour :: AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = [(LogicalColour, AvailableQualifiedMoves x y)]
-> AvailableQualifiedMovesByLogicalColour x y
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
(LogicalColour
logicalColour, LogicalColour -> Game x y -> AvailableQualifiedMoves x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
logicalColour Game x y
game') |
LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
Maybe LogicalColour
maybeChecked' Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour
],
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
forall a. Maybe a
Nothing
}
in ((Game x y, Turn x y), Game x y)
-> Maybe ((Game x y, Turn x y), Game x y)
forall a. a -> Maybe a
Just ((Game x y
game', Turn x y
turn), Game x y
game')
[Turn x y]
_ -> Maybe ((Game x y, Turn x y), Game x y)
forall a. Maybe a
Nothing
)
listQualifiedMovesAvailableTo :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> Attribute.LogicalColour.LogicalColour
-> Game x y
-> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE listQualifiedMovesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
listQualifiedMovesAvailableTo :: LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour game :: Game x y
game@MkGame {
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getMaybeChecked :: forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked = Maybe LogicalColour
maybeChecked
}
| Maybe LogicalColour
maybeChecked Maybe LogicalColour -> Maybe LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour = let
kingsCoordinates :: Coordinates x y
kingsCoordinates = LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
forall x y.
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour
in [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove Move x y
move MoveType
moveType |
(Coordinates x y
destination, Maybe Rank
maybeTakenRank) <- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
kingsCoordinates (LogicalColour -> Piece
Component.Piece.mkKing LogicalColour
logicalColour) MaybePieceByCoordinates x y
maybePieceByCoordinates,
let
move :: Move x y
move = Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
kingsCoordinates Coordinates x y
destination
moveType :: MoveType
moveType = Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
forall a. Maybe a
Nothing ,
[(Coordinates x y, Rank)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Coordinates x y, Rank)] -> Bool)
-> (Board x y -> [(Coordinates x y, Rank)]) -> Board x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour Coordinates x y
destination (Board x y -> Bool) -> Board x y -> Bool
forall a b. (a -> b) -> a -> b
$ Move x y -> Maybe MoveType -> Transformation x y
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Move x y -> Maybe MoveType -> Transformation x y
State.Board.movePiece Move x y
move (MoveType -> Maybe MoveType
forall a. a -> Maybe a
Just MoveType
moveType) Board x y
board
] [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ case LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
logicalColour Coordinates x y
kingsCoordinates Board x y
board of
[(Coordinates x y
checkedFrom, Rank
checkedByRank)] -> Bool -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Rank
checkedByRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.King) ([QualifiedMove x y] -> [QualifiedMove x y])
-> ([QualifiedMove x y] -> [QualifiedMove x y])
-> [QualifiedMove x y]
-> [QualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove x y -> Bool)
-> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (a -> Bool) -> [a] -> [a]
filter QualifiedMove x y -> Bool
isSafeQualifiedMove ([QualifiedMove x y] -> [QualifiedMove x y])
-> [QualifiedMove x y] -> [QualifiedMove x y]
forall a b. (a -> b) -> a -> b
$ (
if Rank
checkedByRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.Pawn
then [QualifiedMove x y]
-> (Turn x y -> [QualifiedMove x y])
-> Maybe (Turn x y)
-> [QualifiedMove x y]
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe [] (
(
\Move x y
lastMove -> let
lastDestination :: Coordinates x y
lastDestination = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
lastMove
pawn :: Piece
pawn = LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour
in [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates x y
lastDestination
) MoveType
Attribute.MoveType.enPassant |
LogicalColour -> Move x y -> Bool
forall x y.
(Enum x, Enum y, Eq y) =>
LogicalColour -> Move x y -> Bool
Component.Move.isPawnDoubleAdvance LogicalColour
opponentsLogicalColour Move x y
lastMove,
Coordinates x y
source <- Coordinates x y -> [Coordinates x y]
forall x y. (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.getAdjacents Coordinates x y
lastDestination,
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
source MaybePieceByCoordinates x y
maybePieceByCoordinates Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just Piece
pawn
]
) (Move x y -> [QualifiedMove x y])
-> (Turn x y -> Move x y) -> Turn x y -> [QualifiedMove x y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
) (Maybe (Turn x y) -> [QualifiedMove x y])
-> Maybe (Turn x y) -> [QualifiedMove x y]
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game
else []
) [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
checkedFrom
) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType (Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
checkedByRank) Maybe Rank
maybePromotionRank |
(Coordinates x y
source, Rank
attackersRank) <- LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> Coordinates x y -> Board x y -> [(Coordinates x y, Rank)]
State.Board.findAttackersOf LogicalColour
opponentsLogicalColour Coordinates x y
checkedFrom Board x y
board,
Rank
attackersRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.King,
Maybe Rank
maybePromotionRank <- Coordinates x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
checkedFrom (Piece -> [Maybe Rank]) -> Piece -> [Maybe Rank]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
attackersRank
] [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
forall a. Maybe a
Nothing Maybe Rank
maybePromotionRank |
Rank
checkedByRank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank
Attribute.Rank.Knight,
Rank
rank <- [Rank]
Attribute.Rank.expendable,
let piece :: Piece
piece = LogicalColour -> Rank -> Piece
Component.Piece.mkPiece LogicalColour
logicalColour Rank
rank,
Coordinates x y
source <- LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
forall x y.
LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
rank CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,
(Coordinates x y
destination, Maybe Rank
Nothing) <- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
source Piece
piece MaybePieceByCoordinates x y
maybePieceByCoordinates,
Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates x y
checkedFrom Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
kingsCoordinates) (Bool -> Bool)
-> ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates x y -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Coordinates x y
destination ([Coordinates x y] -> Bool)
-> ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coordinates x y] -> [Coordinates x y]
forall a. [a] -> [a]
init ([Coordinates x y] -> Bool) -> [Coordinates x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.interpolate Coordinates x y
checkedFrom Coordinates x y
kingsCoordinates,
Maybe Rank
maybePromotionRank <- Coordinates x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination Piece
piece
]
[(Coordinates x y, Rank)]
attackers -> Bool -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
[(Coordinates x y, Rank)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Coordinates x y, Rank)]
attackers Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
) []
| Bool
otherwise = LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
findAvailableCastlingMoves LogicalColour
logicalColour Game x y
game [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ (QualifiedMove x y -> Bool)
-> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. (a -> Bool) -> [a] -> [a]
filter QualifiedMove x y -> Bool
isSafeQualifiedMove (
[
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
) MoveType
Attribute.MoveType.enPassant |
let pawn :: Piece
pawn = LogicalColour -> Piece
Component.Piece.mkPawn LogicalColour
logicalColour,
Coordinates x y
source <- LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
forall x y.
LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Pawn CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,
LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isEnPassantRank LogicalColour
logicalColour Coordinates x y
source,
Coordinates x y
destination <- Coordinates x y -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
Component.Piece.findAttackDestinations Coordinates x y
source Piece
pawn,
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Bool
State.MaybePieceByCoordinates.isVacant Coordinates x y
destination MaybePieceByCoordinates x y
maybePieceByCoordinates,
let opponentsCoordinates :: Coordinates x y
opponentsCoordinates = LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.retreat LogicalColour
logicalColour Coordinates x y
destination,
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> MaybePieceByCoordinates x y -> Maybe Piece
State.MaybePieceByCoordinates.dereference Coordinates x y
opponentsCoordinates MaybePieceByCoordinates x y
maybePieceByCoordinates Maybe Piece -> Maybe Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Piece -> Piece
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Piece
pawn),
Bool -> (Turn x y -> Bool) -> Maybe (Turn x y) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (Turn x y -> (Bool, Bool)) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
opponentsCoordinates) (Coordinates x y -> Bool)
-> (Move x y -> Coordinates x y) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Bool)
-> (Move x y -> Bool) -> Move x y -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
logicalColour Coordinates x y
destination
) (Coordinates x y -> Bool)
-> (Move x y -> Coordinates x y) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource
) (Move x y -> (Bool, Bool))
-> (Turn x y -> Move x y) -> Turn x y -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
) (Maybe (Turn x y) -> Bool) -> Maybe (Turn x y) -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game
] [QualifiedMove x y] -> [QualifiedMove x y] -> [QualifiedMove x y]
forall a. [a] -> [a] -> [a]
++ [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (
Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination
) (MoveType -> QualifiedMove x y) -> MoveType -> QualifiedMove x y
forall a b. (a -> b) -> a -> b
$ Maybe Rank -> Maybe Rank -> MoveType
Attribute.MoveType.mkNormalMoveType Maybe Rank
maybeTakenRank Maybe Rank
maybePromotionRank |
(Coordinates x y
source, Piece
piece) <- LogicalColour
-> CoordinatesByRankByLogicalColour x y
-> [(Coordinates x y, Piece)]
forall x y.
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> [LocatedPiece x y]
State.CoordinatesByRankByLogicalColour.findPiecesOfColour LogicalColour
logicalColour CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,
(Coordinates x y
destination, Maybe Rank
maybeTakenRank) <- Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y
-> Piece
-> MaybePieceByCoordinates x y
-> [(Coordinates x y, Maybe Rank)]
State.MaybePieceByCoordinates.listDestinationsFor Coordinates x y
source Piece
piece MaybePieceByCoordinates x y
maybePieceByCoordinates,
Maybe Rank
maybeTakenRank Maybe Rank -> Maybe Rank -> Bool
forall a. Eq a => a -> a -> Bool
/= Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
Attribute.Rank.King,
Maybe Rank
maybePromotionRank <- Coordinates x y -> Piece -> [Maybe Rank]
forall y x.
(Enum y, Eq y) =>
Coordinates x y -> Piece -> [Maybe Rank]
listMaybePromotionRanks Coordinates x y
destination Piece
piece
]
)
where
opponentsLogicalColour :: LogicalColour
opponentsLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
(MaybePieceByCoordinates x y
maybePieceByCoordinates, CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour) = Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates (Board x y -> MaybePieceByCoordinates x y)
-> (Board x y -> CoordinatesByRankByLogicalColour x y)
-> Board x y
-> (MaybePieceByCoordinates x y,
CoordinatesByRankByLogicalColour x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour (Board x y
-> (MaybePieceByCoordinates x y,
CoordinatesByRankByLogicalColour x y))
-> Board x y
-> (MaybePieceByCoordinates x y,
CoordinatesByRankByLogicalColour x y)
forall a b. (a -> b) -> a -> b
$ Board x y
board
isSafeQualifiedMove :: QualifiedMove x y -> Bool
isSafeQualifiedMove QualifiedMove x y
qualifiedMove = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Move x y -> Board x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour -> Move x y -> Board x y -> Bool
State.Board.exposesKing LogicalColour
logicalColour (QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove) Board x y
board
mkAvailableQualifiedMovesFor :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Attribute.LogicalColour.LogicalColour -> Game x y -> AvailableQualifiedMoves x y
{-# SPECIALISE mkAvailableQualifiedMovesFor :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> AvailableQualifiedMoves Type.Length.X Type.Length.Y #-}
mkAvailableQualifiedMovesFor :: LogicalColour -> Game x y -> AvailableQualifiedMoves x y
mkAvailableQualifiedMovesFor LogicalColour
logicalColour = (QualifiedMove x y
-> AvailableQualifiedMoves x y -> AvailableQualifiedMoves x y)
-> AvailableQualifiedMoves x y
-> [QualifiedMove x y]
-> AvailableQualifiedMoves x y
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\QualifiedMove x y
qualifiedMove -> let
move :: Move x y
move = QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove
in ([(Coordinates x y, MoveType)]
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)])
-> Coordinates x y
-> [(Coordinates x y, MoveType)]
-> AvailableQualifiedMoves x y
-> AvailableQualifiedMoves x y
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.insertWith [(Coordinates x y, MoveType)]
-> [(Coordinates x y, MoveType)] -> [(Coordinates x y, MoveType)]
forall a. [a] -> [a] -> [a]
(++) (
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
) [
(
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move,
QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove
)
]
) AvailableQualifiedMoves x y
forall k a. Map k a
Data.Map.empty ([QualifiedMove x y] -> AvailableQualifiedMoves x y)
-> (Game x y -> [QualifiedMove x y])
-> Game x y
-> AvailableQualifiedMoves x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour
findQualifiedMovesAvailableTo :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
)
=> Attribute.LogicalColour.LogicalColour
-> Game x y
-> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE findQualifiedMovesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
findQualifiedMovesAvailableTo :: LogicalColour -> Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableTo LogicalColour
logicalColour game :: Game x y
game@MkGame { getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour }
| Just AvailableQualifiedMoves x y
availableQualifiedMoves <- LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe (AvailableQualifiedMoves x y)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup LogicalColour
logicalColour AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour = [
Move x y -> MoveType -> QualifiedMove x y
forall x y. Move x y -> MoveType -> QualifiedMove x y
Component.QualifiedMove.mkQualifiedMove (Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
source Coordinates x y
destination) MoveType
moveType |
(Coordinates x y
source, [(Coordinates x y, MoveType)]
qualifiedDestinations) <- AvailableQualifiedMoves x y
-> [(Coordinates x y, [(Coordinates x y, MoveType)])]
forall k a. Map k a -> [(k, a)]
Data.Map.assocs AvailableQualifiedMoves x y
availableQualifiedMoves,
(Coordinates x y
destination, MoveType
moveType) <- [(Coordinates x y, MoveType)]
qualifiedDestinations
]
| Bool
otherwise = LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour Game x y
game
countPliesAvailableTo :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Attribute.LogicalColour.LogicalColour -> Game x y -> Type.Count.NPlies
{-# SPECIALISE countPliesAvailableTo :: Attribute.LogicalColour.LogicalColour -> Game Type.Length.X Type.Length.Y -> Type.Count.NPlies #-}
countPliesAvailableTo :: LogicalColour -> Game x y -> Int
countPliesAvailableTo LogicalColour
logicalColour game :: Game x y
game@MkGame { getAvailableQualifiedMovesByLogicalColour :: forall x y. Game x y -> AvailableQualifiedMovesByLogicalColour x y
getAvailableQualifiedMovesByLogicalColour = AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour }
| Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game = Int
0
| Just AvailableQualifiedMoves x y
availableQualifiedMoves <- LogicalColour
-> AvailableQualifiedMovesByLogicalColour x y
-> Maybe (AvailableQualifiedMoves x y)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup LogicalColour
logicalColour AvailableQualifiedMovesByLogicalColour x y
availableQualifiedMovesByLogicalColour
= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> [(Coordinates x y, MoveType)] -> Int)
-> Int -> AvailableQualifiedMoves x y -> Int
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Data.Map.Strict.foldl' (\Int
acc -> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acc) (Int -> Int)
-> ([(Coordinates x y, MoveType)] -> Int)
-> [(Coordinates x y, MoveType)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Coordinates x y, MoveType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Int
0 AvailableQualifiedMoves x y
availableQualifiedMoves
| Bool
otherwise = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int)
-> ([QualifiedMove x y] -> Int) -> [QualifiedMove x y] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualifiedMove x y] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([QualifiedMove x y] -> Int) -> [QualifiedMove x y] -> Int
forall a b. (a -> b) -> a -> b
$ LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
listQualifiedMovesAvailableTo LogicalColour
logicalColour Game x y
game
findQualifiedMovesAvailableToNextPlayer :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Game x y -> [Component.QualifiedMove.QualifiedMove x y]
{-# SPECIALISE findQualifiedMovesAvailableToNextPlayer :: Game Type.Length.X Type.Length.Y -> [Component.QualifiedMove.QualifiedMove Type.Length.X Type.Length.Y] #-}
findQualifiedMovesAvailableToNextPlayer :: Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableToNextPlayer game :: Game x y
game@MkGame { getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour } = LogicalColour -> Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
LogicalColour -> Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableTo LogicalColour
nextLogicalColour Game x y
game
resignationBy :: Attribute.LogicalColour.LogicalColour -> Transformation x y
resignationBy :: LogicalColour -> Transformation x y
resignationBy LogicalColour
logicalColour Game x y
game
| Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game = Game x y
game
| Bool
otherwise = Game x y
game {
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = GameTerminationReason -> Maybe GameTerminationReason
forall a. a -> Maybe a
Just (GameTerminationReason -> Maybe GameTerminationReason)
-> GameTerminationReason -> Maybe GameTerminationReason
forall a b. (a -> b) -> a -> b
$ LogicalColour -> GameTerminationReason
Rule.GameTerminationReason.mkResignation LogicalColour
logicalColour
}
resign :: Transformation x y
resign :: Transformation x y
resign game :: Game x y
game@MkGame { getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour } = LogicalColour -> Transformation x y
forall x y. LogicalColour -> Transformation x y
resignationBy LogicalColour
nextLogicalColour Game x y
game
agreeToADraw :: Transformation x y
agreeToADraw :: Transformation x y
agreeToADraw Game x y
game
| Game x y -> Bool
forall x y. Game x y -> Bool
isTerminated Game x y
game = Game x y
game
| Bool
otherwise = Game x y
game {
getMaybeTerminationReason :: Maybe GameTerminationReason
getMaybeTerminationReason = GameTerminationReason -> Maybe GameTerminationReason
forall a. a -> Maybe a
Just (GameTerminationReason -> Maybe GameTerminationReason)
-> GameTerminationReason -> Maybe GameTerminationReason
forall a b. (a -> b) -> a -> b
$ DrawReason -> GameTerminationReason
Rule.GameTerminationReason.mkDraw DrawReason
Rule.DrawReason.byAgreement
}
isTerminated :: Game x y -> Bool
isTerminated :: Game x y -> Bool
isTerminated MkGame { getMaybeTerminationReason :: forall x y. Game x y -> Maybe GameTerminationReason
getMaybeTerminationReason = Maybe GameTerminationReason
maybeTerminationReason } = Maybe GameTerminationReason -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust Maybe GameTerminationReason
maybeTerminationReason
inferMaybeTerminationReason :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Game x y -> Maybe Rule.GameTerminationReason.GameTerminationReason
{-# SPECIALISE inferMaybeTerminationReason :: Game Type.Length.X Type.Length.Y -> Maybe Rule.GameTerminationReason.GameTerminationReason #-}
inferMaybeTerminationReason :: Game x y -> Maybe GameTerminationReason
inferMaybeTerminationReason game :: Game x y
game@MkGame {
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getInstancesByPosition :: forall x y. Game x y -> InstancesByPosition x y
getInstancesByPosition = InstancesByPosition x y
instancesByPosition
}
| Bool
haveZeroMoves
, Just LogicalColour
logicalColour <- Game x y -> Maybe LogicalColour
forall x y. Game x y -> Maybe LogicalColour
getMaybeChecked Game x y
game = GameTerminationReason -> Maybe GameTerminationReason
forall a. a -> Maybe a
Just (GameTerminationReason -> Maybe GameTerminationReason)
-> GameTerminationReason -> Maybe GameTerminationReason
forall a b. (a -> b) -> a -> b
$ LogicalColour -> GameTerminationReason
Rule.GameTerminationReason.mkCheckMate LogicalColour
logicalColour
| Bool
otherwise = (DrawReason -> GameTerminationReason)
-> Maybe DrawReason -> Maybe GameTerminationReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DrawReason -> GameTerminationReason
Rule.GameTerminationReason.mkDraw Maybe DrawReason
maybeDrawReason
where
haveZeroMoves :: Bool
haveZeroMoves :: Bool
haveZeroMoves = [QualifiedMove x y] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([QualifiedMove x y] -> Bool) -> [QualifiedMove x y] -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y -> [QualifiedMove x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> [QualifiedMove x y]
findQualifiedMovesAvailableToNextPlayer Game x y
game
maybeDrawReason :: Maybe Rule.DrawReason.DrawReason
maybeDrawReason :: Maybe DrawReason
maybeDrawReason
| Bool
haveZeroMoves = DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.staleMate
| (Int -> Bool) -> InstancesByPosition x y -> Bool
forall position.
(Int -> Bool) -> InstancesByPosition position -> Bool
State.InstancesByPosition.anyInstancesByPosition (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Rule.DrawReason.maximumConsecutiveRepeatablePositions) InstancesByPosition x y
instancesByPosition = DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.fiveFoldRepetition
| InstancesByPosition x y -> Int
forall position. InstancesByPosition position -> Int
State.InstancesByPosition.countConsecutiveRepeatablePlies InstancesByPosition x y
instancesByPosition Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
Rule.DrawReason.maximumConsecutiveRepeatablePlies = DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.seventyFiveMoveRule
| CoordinatesByRankByLogicalColour x y -> Bool
forall censor. Censor censor => censor -> Bool
StateProperty.Censor.hasInsufficientMaterial (CoordinatesByRankByLogicalColour x y -> Bool)
-> CoordinatesByRankByLogicalColour x y -> Bool
forall a b. (a -> b) -> a -> b
$ Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
board = DrawReason -> Maybe DrawReason
forall a. a -> Maybe a
Just DrawReason
Rule.DrawReason.insufficientMaterial
| Bool
otherwise = Maybe DrawReason
forall a. Maybe a
Nothing
updateTerminationReasonWith :: Rule.Result.Result -> Transformation x y
updateTerminationReasonWith :: Result -> Transformation x y
updateTerminationReasonWith Result
result Game x y
game
| Just LogicalColour
victorsLogicalColour <- Result -> Maybe LogicalColour
Rule.Result.findMaybeVictor Result
result = LogicalColour -> Transformation x y
forall x y. LogicalColour -> Transformation x y
resignationBy (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
victorsLogicalColour) Game x y
game
| Bool
otherwise = Transformation x y
forall x y. Transformation x y
agreeToADraw Game x y
game
cantConverge :: Game x y -> Game x y -> Bool
cantConverge :: Game x y -> Game x y -> Bool
cantConverge MkGame {
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour
} MkGame {
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour'
} = CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
forall x.
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
State.CastleableRooksByLogicalColour.cantConverge CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour'
mkPosition :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Game x y -> State.Position.Position x y
{-# SPECIALISE mkPosition :: Game Type.Length.X Type.Length.Y -> State.Position.Position Type.Length.X Type.Length.Y #-}
mkPosition :: Game x y -> Position x y
mkPosition game :: Game x y
game@MkGame {
getNextLogicalColour :: forall x y. Game x y -> LogicalColour
getNextLogicalColour = LogicalColour
nextLogicalColour,
getBoard :: forall x y. Game x y -> Board x y
getBoard = Board x y
board,
getCastleableRooksByLogicalColour :: forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour
} = LogicalColour
-> MaybePieceByCoordinates x y
-> CastleableRooksByLogicalColour x
-> Maybe (Turn x y)
-> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> MaybePieceByCoordinates x y
-> CastleableRooksByLogicalColour x
-> Maybe (Turn x y)
-> Position x y
State.Position.mkPosition LogicalColour
nextLogicalColour (Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates Board x y
board) CastleableRooksByLogicalColour x
castleableRooksByLogicalColour (Maybe (Turn x y) -> Position x y)
-> Maybe (Turn x y) -> Position x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game
mkInstancesByPosition :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x,
Show y
) => Game x y -> InstancesByPosition x y
{-# SPECIALISE mkInstancesByPosition :: Game Type.Length.X Type.Length.Y -> InstancesByPosition Type.Length.X Type.Length.Y #-}
mkInstancesByPosition :: Game x y -> InstancesByPosition x y
mkInstancesByPosition = Map (Position x y) Int -> InstancesByPosition x y
forall position. Map position Int -> InstancesByPosition position
State.InstancesByPosition.mkInstancesByPosition (Map (Position x y) Int -> InstancesByPosition x y)
-> (Game x y -> Map (Position x y) Int)
-> Game x y
-> InstancesByPosition x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Position x y) Int
-> [(Game x y, Turn x y)] -> Map (Position x y) Int)
-> (Map (Position x y) Int, [(Game x y, Turn x y)])
-> Map (Position x y) Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (
((Game x y, Turn x y)
-> Map (Position x y) Int -> Map (Position x y) Int)
-> Map (Position x y) Int
-> [(Game x y, Turn x y)]
-> Map (Position x y) Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Game x y, Turn x y)
-> Map (Position x y) Int -> Map (Position x y) Int)
-> Map (Position x y) Int
-> [(Game x y, Turn x y)]
-> Map (Position x y) Int)
-> ((Game x y, Turn x y)
-> Map (Position x y) Int -> Map (Position x y) Int)
-> Map (Position x y) Int
-> [(Game x y, Turn x y)]
-> Map (Position x y) Int
forall a b. (a -> b) -> a -> b
$ (Position x y
-> Int -> Map (Position x y) Int -> Map (Position x y) Int)
-> Int
-> Position x y
-> Map (Position x y) Int
-> Map (Position x y) Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> Int -> Int)
-> Position x y
-> Int
-> Map (Position x y) Int
-> Map (Position x y) Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Data.Map.Strict.insertWith ((Int -> Int -> Int)
-> Position x y
-> Int
-> Map (Position x y) Int
-> Map (Position x y) Int)
-> (Int -> Int -> Int)
-> Position x y
-> Int
-> Map (Position x y) Int
-> Map (Position x y) Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. Enum a => a -> a
succ) Int
1 (Position x y -> Map (Position x y) Int -> Map (Position x y) Int)
-> ((Game x y, Turn x y) -> Position x y)
-> (Game x y, Turn x y)
-> Map (Position x y) Int
-> Map (Position x y) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition (Game x y -> Position x y)
-> ((Game x y, Turn x y) -> Game x y)
-> (Game x y, Turn x y)
-> Position x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game x y, Turn x y) -> Game x y
forall a b. (a, b) -> a
fst
) ((Map (Position x y) Int, [(Game x y, Turn x y)])
-> Map (Position x y) Int)
-> (Game x y -> (Map (Position x y) Int, [(Game x y, Turn x y)]))
-> Game x y
-> Map (Position x y) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(Position x y -> Int -> Map (Position x y) Int
forall k a. k -> a -> Map k a
`Data.Map.Strict.singleton` Int
1) (Position x y -> Map (Position x y) Int)
-> (Game x y -> Position x y) -> Game x y -> Map (Position x y) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition (Game x y -> Map (Position x y) Int)
-> (Game x y -> [(Game x y, Turn x y)])
-> Game x y
-> (Map (Position x y) Int, [(Game x y, Turn x y)])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game x y, Turn x y) -> Bool)
-> [(Game x y, Turn x y)] -> [(Game x y, Turn x y)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (
Turn x y -> Bool
forall x y. Turn x y -> Bool
Component.Turn.getIsRepeatableMove (Turn x y -> Bool)
-> ((Game x y, Turn x y) -> Turn x y)
-> (Game x y, Turn x y)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Game x y, Turn x y) -> Turn x y
forall a b. (a, b) -> b
snd
) ([(Game x y, Turn x y)] -> [(Game x y, Turn x y)])
-> (Game x y -> [(Game x y, Turn x y)])
-> Game x y
-> [(Game x y, Turn x y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Game x y -> [(Game x y, Turn x y)]
forall x y.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y) =>
Game x y -> [(Game x y, Turn x y)]
rollBack
)
(=~) :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Game x y -> Game x y -> Bool
{-# SPECIALISE (=~) :: Game Type.Length.X Type.Length.Y -> Game Type.Length.X Type.Length.Y -> Bool #-}
Game x y
game =~ :: Game x y -> Game x y -> Bool
=~ Game x y
game' = Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game Position x y -> Position x y -> Bool
forall a. Eq a => a -> a -> Bool
== Game x y -> Position x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Position x y
mkPosition Game x y
game'
(/~) :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Game x y -> Game x y -> Bool
Game x y
game /~ :: Game x y -> Game x y -> Bool
/~ Game x y
game' = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Game x y
game Game x y -> Game x y -> Bool
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Game x y -> Game x y -> Bool
=~ Game x y
game'
updateIncrementalPositionHash :: (
Data.Array.IArray.Ix x,
Data.Bits.Bits positionHash,
Enum x,
Enum y,
Ord y
)
=> Game x y
-> positionHash
-> Game x y
-> Component.Zobrist.Zobrist x y positionHash
-> positionHash
{-# SPECIALISE updateIncrementalPositionHash :: Game Type.Length.X Type.Length.Y -> Type.Crypto.PositionHash -> Game Type.Length.X Type.Length.Y -> Component.Zobrist.Zobrist Type.Length.X Type.Length.Y Type.Crypto.PositionHash -> Type.Crypto.PositionHash #-}
updateIncrementalPositionHash :: Game x y
-> positionHash
-> Game x y
-> Zobrist x y positionHash
-> positionHash
updateIncrementalPositionHash Game x y
game positionHash
positionHash Game x y
game' Zobrist x y positionHash
zobrist = positionHash -> [positionHash] -> positionHash
forall positionHash.
Bits positionHash =>
positionHash -> [positionHash] -> positionHash
Component.Zobrist.combine positionHash
positionHash ([positionHash] -> positionHash)
-> ([positionHash] -> [positionHash])
-> [positionHash]
-> positionHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
(++) [positionHash]
randomsFromMoveType ([positionHash] -> [positionHash])
-> ([positionHash] -> [positionHash])
-> [positionHash]
-> [positionHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
let
(CastleableRooksByLogicalColour x
castleableRooksByLogicalColour, CastleableRooksByLogicalColour x
castleableRooksByLogicalColour') = ((Game x y -> CastleableRooksByLogicalColour x)
-> Game x y -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ Game x y
game) ((Game x y -> CastleableRooksByLogicalColour x)
-> CastleableRooksByLogicalColour x)
-> ((Game x y -> CastleableRooksByLogicalColour x)
-> CastleableRooksByLogicalColour x)
-> (Game x y -> CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x,
CastleableRooksByLogicalColour x)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((Game x y -> CastleableRooksByLogicalColour x)
-> Game x y -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ Game x y
game') ((Game x y -> CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x,
CastleableRooksByLogicalColour x))
-> (Game x y -> CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x,
CastleableRooksByLogicalColour x)
forall a b. (a -> b) -> a -> b
$ Game x y -> CastleableRooksByLogicalColour x
forall x y. Game x y -> CastleableRooksByLogicalColour x
getCastleableRooksByLogicalColour
in if Bool
isCastle Bool -> Bool -> Bool
|| CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
forall a. Eq a => a -> a -> Bool
/= CastleableRooksByLogicalColour x
castleableRooksByLogicalColour'
then (
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Zobrist x y positionHash
-> [positionHash]
forall x y random.
Ix x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Zobrist x y random
-> [random]
State.CastleableRooksByLogicalColour.listIncrementalRandoms CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour' Zobrist x y positionHash
zobrist [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++
)
else [positionHash] -> [positionHash]
forall a. a -> a
id
) ([positionHash] -> positionHash) -> [positionHash] -> positionHash
forall a b. (a -> b) -> a -> b
$ [
positionHash
random |
Just EnPassantAbscissa x
enPassantAbscissa <- (Game x y -> Maybe (EnPassantAbscissa x))
-> [Game x y] -> [Maybe (EnPassantAbscissa x)]
forall a b. (a -> b) -> [a] -> [b]
map (
\Game x y
g -> Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
g Maybe (Turn x y)
-> (Turn x y -> Maybe (EnPassantAbscissa x))
-> Maybe (EnPassantAbscissa x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
LogicalColour
-> MaybePieceByCoordinates x y
-> Turn x y
-> Maybe (EnPassantAbscissa x)
State.EnPassantAbscissa.mkMaybeEnPassantAbscissa (
Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
getNextLogicalColour Game x y
g
) (
Board x y -> MaybePieceByCoordinates x y
forall x y. Board x y -> MaybePieceByCoordinates x y
State.Board.getMaybePieceByCoordinates (Board x y -> MaybePieceByCoordinates x y)
-> Board x y -> MaybePieceByCoordinates x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Board x y
forall x y. Game x y -> Board x y
getBoard Game x y
g
)
) [Game x y
game, Game x y
game'],
positionHash
random <- EnPassantAbscissa x -> Zobrist x y positionHash -> [positionHash]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms1D EnPassantAbscissa x
enPassantAbscissa Zobrist x y positionHash
zobrist
] [positionHash] -> [positionHash] -> [positionHash]
forall a. [a] -> [a] -> [a]
++ Zobrist x y positionHash -> positionHash
forall x y positionHash. Zobrist x y positionHash -> positionHash
Component.Zobrist.getRandomForBlacksMove Zobrist x y positionHash
zobrist positionHash -> [positionHash] -> [positionHash]
forall a. a -> [a] -> [a]
: [
Index x y -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y) =>
Index x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (LogicalColour
lastLogicalColour, Turn x y -> Rank
rankAccessor Turn x y
turn, Move x y -> Coordinates x y
coordinatesAccessor Move x y
move) Zobrist x y positionHash
zobrist |
(Turn x y -> Rank
rankAccessor, Move x y -> Coordinates x y
coordinatesAccessor) <- [Turn x y -> Rank]
-> [Move x y -> Coordinates x y]
-> [(Turn x y -> Rank, Move x y -> Coordinates x y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank, (Rank -> Maybe Rank -> Rank
forall a. a -> Maybe a -> a
`Data.Maybe.fromMaybe` MoveType -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank MoveType
moveType) (Rank -> Rank) -> (Turn x y -> Rank) -> Turn x y -> Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank] [Move x y -> Coordinates x y]
forall x y. [Move x y -> Coordinates x y]
coordinatesAccessors
] where
lastLogicalColour :: LogicalColour
lastLogicalColour = Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
getNextLogicalColour Game x y
game
turn :: Turn x y
turn = Turn x y -> Maybe (Turn x y) -> Turn x y
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (
Exception -> Turn x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Turn x y) -> Exception -> Turn x y
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkNullDatum String
"BishBosh.Model.Game.updateIncrementalPositionHash:\tzero turns have been made."
) (Maybe (Turn x y) -> Turn x y) -> Maybe (Turn x y) -> Turn x y
forall a b. (a -> b) -> a -> b
$ Game x y -> Maybe (Turn x y)
forall x y. Game x y -> Maybe (Turn x y)
maybeLastTurn Game x y
game'
(Move x y
move, MoveType
moveType) = QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (QualifiedMove x y -> MoveType)
-> QualifiedMove x y
-> (Move x y, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y -> (Move x y, MoveType))
-> QualifiedMove x y -> (Move x y, MoveType)
forall a b. (a -> b) -> a -> b
$ Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
isCastle :: Bool
isCastle = MoveType -> Bool
Attribute.MoveType.isCastle MoveType
moveType
coordinatesAccessors :: [Move x y -> Coordinates x y]
coordinatesAccessors = [Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource, Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination]
randomsFromMoveType :: [positionHash]
randomsFromMoveType
| Just Rank
rank <- MoveType -> Maybe Rank
Attribute.MoveType.getMaybeExplicitlyTakenRank MoveType
moveType = [Index x y -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y) =>
Index x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (LogicalColour
nextLogicalColour, Rank
rank, Coordinates x y
destination) Zobrist x y positionHash
zobrist]
| Bool
isCastle = ((Move x y -> Coordinates x y) -> positionHash)
-> [Move x y -> Coordinates x y] -> [positionHash]
forall a b. (a -> b) -> [a] -> [b]
map (
\Move x y -> Coordinates x y
coordinatesAccessor -> Index x y -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y) =>
Index x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (
LogicalColour
lastLogicalColour,
Rank
Attribute.Rank.Rook,
Coordinates x y
-> (CastlingMove x y -> Coordinates x y)
-> Maybe (CastlingMove x y)
-> Coordinates x y
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Exception -> Coordinates x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Coordinates x y) -> Exception -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkSearchFailure String
"BishBosh.Model.Game.updateIncrementalPositionHash.randomsFromMoveType:\tfailed to find castling-move."
) (
Move x y -> Coordinates x y
coordinatesAccessor (Move x y -> Coordinates x y)
-> (CastlingMove x y -> Move x y)
-> CastlingMove x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getRooksMove
) (Maybe (CastlingMove x y) -> Coordinates x y)
-> ([CastlingMove x y] -> Maybe (CastlingMove x y))
-> [CastlingMove x y]
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CastlingMove x y -> Bool)
-> [CastlingMove x y] -> Maybe (CastlingMove x y)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
(Move x y -> Move x y -> Bool
forall a. Eq a => a -> a -> Bool
== Move x y
move) (Move x y -> Bool)
-> (CastlingMove x y -> Move x y) -> CastlingMove x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CastlingMove x y -> Move x y
forall x y. CastlingMove x y -> Move x y
Component.CastlingMove.getKingsMove
) ([CastlingMove x y] -> Coordinates x y)
-> [CastlingMove x y] -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
Component.CastlingMove.getCastlingMoves LogicalColour
lastLogicalColour
) Zobrist x y positionHash
zobrist
) [Move x y -> Coordinates x y]
forall x y. [Move x y -> Coordinates x y]
coordinatesAccessors
| MoveType -> Bool
Attribute.MoveType.isEnPassant MoveType
moveType = [Index x y -> Zobrist x y positionHash -> positionHash
forall x y positionHash.
(Enum x, Enum y, Ord x, Ord y) =>
Index x y -> Zobrist x y positionHash -> positionHash
Component.Zobrist.dereferenceRandomByCoordinatesByRankByLogicalColour (LogicalColour
nextLogicalColour, Rank
Attribute.Rank.Pawn, LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
Cartesian.Coordinates.advance LogicalColour
nextLogicalColour Coordinates x y
destination) Zobrist x y positionHash
zobrist]
| Bool
otherwise = []
where
nextLogicalColour :: LogicalColour
nextLogicalColour = Game x y -> LogicalColour
forall x y. Game x y -> LogicalColour
getNextLogicalColour Game x y
game'
destination :: Coordinates x y
destination = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move