module BishBosh.State.CastleableRooksByLogicalColour(
TurnsByLogicalColour,
CastleableRooksByLogicalColour(),
locateForLogicalColour,
fromAssocs,
fromBoard,
fromTurnsByLogicalColour,
listIncrementalRandoms,
unify,
takeTurn,
hasCastled,
canCastle,
canCastleWith,
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.Ordinate as Cartesian.Ordinate
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.Property.ExtendedPositionDescription as Property.ExtendedPositionDescription
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.State.Board as State.Board
import qualified BishBosh.State.CoordinatesByRankByLogicalColour as State.CoordinatesByRankByLogicalColour
import qualified BishBosh.StateProperty.Hashable as StateProperty.Hashable
import qualified BishBosh.State.TurnsByLogicalColour as State.TurnsByLogicalColour
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Char
import qualified Data.Default
import qualified Data.List
import qualified Data.List.Extra
import qualified Data.Maybe
import qualified Data.Ord
type AbscissaeByLogicalColour = [(Attribute.LogicalColour.LogicalColour, [Type.Length.X])]
sortByLogicalColour :: AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour :: AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour = ((LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering)
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X]) -> (LogicalColour, [X]) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst
castle :: Attribute.LogicalColour.LogicalColour -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
castle :: LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
castle LogicalColour
logicalColour = ((LogicalColour, [X]) -> Bool)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. (a -> Bool) -> [a] -> [a]
filter (((LogicalColour, [X]) -> Bool)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> Bool)
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour) (LogicalColour -> Bool)
-> ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst
relinquishCastlingRights :: Attribute.LogicalColour.LogicalColour -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
relinquishCastlingRights :: LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
relinquishCastlingRights LogicalColour
logicalColour = ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ \pair :: (LogicalColour, [X])
pair@(LogicalColour
logicalColour', [X]
_) -> (
if LogicalColour
logicalColour' LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour
then ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X]))
-> ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall a b. (a -> b) -> a -> b
$ [X] -> [X] -> [X]
forall a b. a -> b -> a
const []
else (LogicalColour, [X]) -> (LogicalColour, [X])
forall a. a -> a
id
) (LogicalColour, [X])
pair
removeX
:: Attribute.LogicalColour.LogicalColour
-> Type.Length.X
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
removeX :: LogicalColour
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
removeX LogicalColour
logicalColour X
x = ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ \pair :: (LogicalColour, [X])
pair@(LogicalColour
logicalColour', [X]
_) -> (
if LogicalColour
logicalColour' LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour
then ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second (([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X]))
-> ([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall a b. (a -> b) -> a -> b
$ X -> [X] -> [X]
forall a. Eq a => a -> [a] -> [a]
Data.List.delete X
x
else (LogicalColour, [X]) -> (LogicalColour, [X])
forall a. a -> a
id
) (LogicalColour, [X])
pair
canCastleWith'
:: Attribute.LogicalColour.LogicalColour
-> Type.Length.X
-> AbscissaeByLogicalColour
-> Bool
canCastleWith' :: LogicalColour -> X -> AbscissaeByLogicalColour -> Bool
canCastleWith' LogicalColour
logicalColour X
x = Bool -> ([X] -> Bool) -> Maybe [X] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (X -> [X] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem X
x) (Maybe [X] -> Bool)
-> (AbscissaeByLogicalColour -> Maybe [X])
-> AbscissaeByLogicalColour
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour
newtype CastleableRooksByLogicalColour = MkCastleableRooksByLogicalColour {
CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs :: AbscissaeByLogicalColour
} deriving (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
(CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool)
-> Eq CastleableRooksByLogicalColour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c/= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
== :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c== :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
Eq, Eq CastleableRooksByLogicalColour
Eq CastleableRooksByLogicalColour
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour)
-> (CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour)
-> Ord CastleableRooksByLogicalColour
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering
CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
$cmin :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
max :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
$cmax :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
>= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c>= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
> :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c> :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
<= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c<= :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
< :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
$c< :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
compare :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering
$ccompare :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Ordering
$cp1Ord :: Eq CastleableRooksByLogicalColour
Ord)
instance Show CastleableRooksByLogicalColour where
showsPrec :: X -> CastleableRooksByLogicalColour -> ShowS
showsPrec X
precedence MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = X -> AbscissaeByLogicalColour -> ShowS
forall a. Show a => X -> a -> ShowS
showsPrec X
precedence AbscissaeByLogicalColour
assocs
instance Read CastleableRooksByLogicalColour where
readsPrec :: X -> ReadS CastleableRooksByLogicalColour
readsPrec X
precedence String
s = (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> (AbscissaeByLogicalColour, String)
-> (CastleableRooksByLogicalColour, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs ((AbscissaeByLogicalColour, String)
-> (CastleableRooksByLogicalColour, String))
-> [(AbscissaeByLogicalColour, String)]
-> [(CastleableRooksByLogicalColour, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` X -> ReadS AbscissaeByLogicalColour
forall a. Read a => X -> ReadS a
readsPrec X
precedence String
s
instance Control.DeepSeq.NFData CastleableRooksByLogicalColour where
rnf :: CastleableRooksByLogicalColour -> ()
rnf MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = AbscissaeByLogicalColour -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf AbscissaeByLogicalColour
assocs
instance Data.Default.Default CastleableRooksByLogicalColour where
def :: CastleableRooksByLogicalColour
def = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, [X]))
-> [LogicalColour] -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (
(LogicalColour -> [X] -> (LogicalColour, [X]))
-> [X] -> LogicalColour -> (LogicalColour, [X])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [X
Cartesian.Abscissa.xMin, X
Cartesian.Abscissa.xMax]
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
instance Property.Reflectable.ReflectableOnX CastleableRooksByLogicalColour where
reflectOnX :: CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
reflectOnX MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. [a] -> [a]
reverse (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (
(LogicalColour -> LogicalColour)
-> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite
) AbscissaeByLogicalColour
assocs
instance Property.ExtendedPositionDescription.ReadsEPD CastleableRooksByLogicalColour where
readsEPD :: ReadS CastleableRooksByLogicalColour
readsEPD String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
'-' : String
remainder -> [
(
AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members [LogicalColour] -> [[X]] -> AbscissaeByLogicalColour
forall a b. [a] -> [b] -> [(a, b)]
`zip` [X] -> [[X]]
forall a. a -> [a]
repeat [],
String
remainder
)
]
String
s1 -> let
readsAssocs :: String -> [([(LogicalColour, X)], String)]
readsAssocs String
s'
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s' Bool -> Bool -> Bool
|| Char -> Bool
Data.Char.isSpace (String -> Char
forall a. [a] -> a
head String
s') = [([(LogicalColour, X)], String)]
forall a. [([a], String)]
terminate
| Bool
otherwise = case ReadS Piece
forall a. Read a => ReadS a
reads String
s' of
[(Piece
piece, String
s'')] -> case Piece -> Rank
Component.Piece.getRank Piece
piece of
Rank
Attribute.Rank.Queen -> ([(LogicalColour, X)] -> [(LogicalColour, X)])
-> ([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
(
LogicalColour
logicalColour,
X
Cartesian.Abscissa.xMin
) (LogicalColour, X) -> [(LogicalColour, X)] -> [(LogicalColour, X)]
forall a. a -> [a] -> [a]
:
) (([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String))
-> [([(LogicalColour, X)], String)]
-> [([(LogicalColour, X)], String)]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [([(LogicalColour, X)], String)]
readsAssocs String
s''
Rank
Attribute.Rank.King -> ([(LogicalColour, X)] -> [(LogicalColour, X)])
-> ([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
(
LogicalColour
logicalColour,
X
Cartesian.Abscissa.xMax
) (LogicalColour, X) -> [(LogicalColour, X)] -> [(LogicalColour, X)]
forall a. a -> [a] -> [a]
:
) (([(LogicalColour, X)], String) -> ([(LogicalColour, X)], String))
-> [([(LogicalColour, X)], String)]
-> [([(LogicalColour, X)], String)]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [([(LogicalColour, X)], String)]
readsAssocs String
s''
Rank
_ -> []
where
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece
[(Piece, String)]
_ -> [([(LogicalColour, X)], String)]
forall a. [([a], String)]
terminate
where
terminate :: [([a], String)]
terminate = [([], String
s')]
in case String -> [([(LogicalColour, X)], String)]
readsAssocs String
s1 of
[([], String
_)] -> []
[([(LogicalColour, X)], String)]
l -> ([(LogicalColour, X)] -> CastleableRooksByLogicalColour)
-> ([(LogicalColour, X)], String)
-> (CastleableRooksByLogicalColour, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> ([(LogicalColour, X)] -> AbscissaeByLogicalColour)
-> [(LogicalColour, X)]
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LogicalColour, X)] -> AbscissaeByLogicalColour
forall k v. Ord k => [(k, v)] -> [(k, [v])]
Data.List.Extra.groupSort) (([(LogicalColour, X)], String)
-> (CastleableRooksByLogicalColour, String))
-> [([(LogicalColour, X)], String)]
-> [(CastleableRooksByLogicalColour, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` [([(LogicalColour, X)], String)]
l
instance Property.ExtendedPositionDescription.ShowsEPD CastleableRooksByLogicalColour where
showsEPD :: CastleableRooksByLogicalColour -> ShowS
showsEPD MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs }
| ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([X] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([X] -> Bool)
-> ((LogicalColour, [X]) -> [X]) -> (LogicalColour, [X]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> [X]
forall a b. (a, b) -> b
snd) AbscissaeByLogicalColour
assocs = ShowS
Property.ExtendedPositionDescription.showsNullField
| Bool
otherwise = (Piece -> ShowS -> ShowS) -> ShowS -> [Piece] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (ShowS -> ShowS -> ShowS)
-> (Piece -> ShowS) -> Piece -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
forall a. ShowsEPD a => a -> ShowS
Property.ExtendedPositionDescription.showsEPD
) ShowS
forall a. a -> a
id [
LogicalColour -> Piece
pieceConstructor LogicalColour
logicalColour |
LogicalColour
logicalColour <- [LogicalColour
Attribute.LogicalColour.White, LogicalColour
Attribute.LogicalColour.Black],
(X
rooksX, LogicalColour -> Piece
pieceConstructor) <- [(X
Cartesian.Abscissa.xMax, LogicalColour -> Piece
Component.Piece.mkKing), (X
Cartesian.Abscissa.xMin, LogicalColour -> Piece
Component.Piece.mkQueen)],
LogicalColour -> X -> AbscissaeByLogicalColour -> Bool
canCastleWith' LogicalColour
logicalColour X
rooksX AbscissaeByLogicalColour
assocs
]
instance Property.ForsythEdwards.ReadsFEN CastleableRooksByLogicalColour
instance Property.ForsythEdwards.ShowsFEN CastleableRooksByLogicalColour
instance StateProperty.Hashable.Hashable CastleableRooksByLogicalColour where
listRandoms :: CastleableRooksByLogicalColour
-> Zobrist positionHash -> [positionHash]
listRandoms MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } Zobrist positionHash
zobrist = [Maybe positionHash] -> [positionHash]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes [
LogicalColour -> X -> Zobrist positionHash -> Maybe positionHash
forall positionHash.
LogicalColour -> X -> Zobrist positionHash -> Maybe positionHash
Component.Zobrist.dereferenceRandomByCastleableRooksXByLogicalColour LogicalColour
logicalColour X
x Zobrist positionHash
zobrist |
LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
X
x <- [X] -> Maybe [X] -> [X]
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe [] (Maybe [X] -> [X]) -> Maybe [X] -> [X]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs
]
fromAssocs :: AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs :: AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs AbscissaeByLogicalColour
assocs
| [LogicalColour] -> Bool
forall a. Eq a => [a] -> Bool
Data.List.Extra.anySame ([LogicalColour] -> Bool) -> [LogicalColour] -> Bool
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> LogicalColour)
-> AbscissaeByLogicalColour -> [LogicalColour]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst AbscissaeByLogicalColour
assocs = Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.CastleableRooksByLogicalColour.fromAssocs:\tduplicate logical colours have been defined; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour
assocs String
"."
| ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([X] -> Bool
forall a. Eq a => [a] -> Bool
Data.List.Extra.anySame ([X] -> Bool)
-> ((LogicalColour, [X]) -> [X]) -> (LogicalColour, [X]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> [X]
forall a b. (a, b) -> b
snd) AbscissaeByLogicalColour
assocs = Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.CastleableRooksByLogicalColour.fromAssocs:\tduplicate abscissae have been defined; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour
assocs String
"."
| ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
X -> [X] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [X
Cartesian.Abscissa.xMin, X
Cartesian.Abscissa.xMax]
) ([X] -> Bool)
-> ((LogicalColour, [X]) -> [X]) -> (LogicalColour, [X]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> [X]
forall a b. (a, b) -> b
snd
) AbscissaeByLogicalColour
assocs = Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
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.State.CastleableRooksByLogicalColour.fromAssocs:\tall abscissae must reference unmoved Rooks; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour
assocs String
"."
| Bool
otherwise = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [X]) -> (LogicalColour, [X]))
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (([X] -> [X]) -> (LogicalColour, [X]) -> (LogicalColour, [X])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [X] -> [X]
forall a. Ord a => [a] -> [a]
Data.List.sort) AbscissaeByLogicalColour
assocs
fromBoard :: State.Board.Board -> CastleableRooksByLogicalColour
fromBoard :: Board -> CastleableRooksByLogicalColour
fromBoard Board
board
| (LogicalColour -> Bool) -> [LogicalColour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
\LogicalColour
logicalColour -> LogicalColour -> CastleableRooksByLogicalColour -> Bool
hasCastled LogicalColour
logicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour Bool -> Bool -> Bool
&& (Coordinates -> Bool) -> [Coordinates] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
Coordinates -> [Coordinates] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Pawn CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour
) [
X -> X -> Coordinates
Cartesian.Coordinates.mkCoordinates X
x (
LogicalColour -> X
Cartesian.Ordinate.pawnsFirstRank LogicalColour
logicalColour
) |
X
bishopsAbscissa <- [X]
Cartesian.Abscissa.bishopsFiles,
X
x <- X -> [X]
Cartesian.Abscissa.getAdjacents X
bishopsAbscissa
]
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members = Exception -> CastleableRooksByLogicalColour
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkIncompatibleData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.State.CastleableRooksByLogicalColourFromBoard.fromBoard:\tfor castling to have occurred, a Bishop must have been moved, which can only happen when a blocking Pawn is moved; " (String -> CastleableRooksByLogicalColour)
-> String -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (CastleableRooksByLogicalColour, Board) -> ShowS
forall a. Show a => a -> ShowS
shows (CastleableRooksByLogicalColour
castleableRooksByLogicalColour, Board
board) String
"."
| Bool
otherwise = CastleableRooksByLogicalColour
castleableRooksByLogicalColour
where
coordinatesByRankByLogicalColour :: CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour = Board -> CoordinatesByRankByLogicalColour
State.Board.getCoordinatesByRankByLogicalColour Board
board
castleableRooksByLogicalColour :: CastleableRooksByLogicalColour
castleableRooksByLogicalColour = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
fromAssocs (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, [X]))
-> [LogicalColour] -> AbscissaeByLogicalColour
forall a b. (a -> b) -> [a] -> [b]
map (
\LogicalColour
logicalColour -> (
LogicalColour
logicalColour,
[
Coordinates -> X
Cartesian.Coordinates.getX Coordinates
rooksCoordinates |
LogicalColour -> CoordinatesByRankByLogicalColour -> Coordinates
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour,
Coordinates
rooksCoordinates <- LogicalColour
-> Rank -> CoordinatesByRankByLogicalColour -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Rook CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour,
Coordinates
rooksCoordinates Coordinates -> [Coordinates] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LogicalColour -> [Coordinates]
Cartesian.Coordinates.rooksStartingCoordinates LogicalColour
logicalColour
]
)
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
type TurnsByLogicalColour = State.TurnsByLogicalColour.TurnsByLogicalColour Component.Turn.Turn
fromTurnsByLogicalColour :: TurnsByLogicalColour -> CastleableRooksByLogicalColour
fromTurnsByLogicalColour :: TurnsByLogicalColour -> CastleableRooksByLogicalColour
fromTurnsByLogicalColour TurnsByLogicalColour
turnsByLogicalColour = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> [LogicalColour]
-> AbscissaeByLogicalColour
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\LogicalColour
logicalColour -> let
turns :: [Turn]
turns = LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
logicalColour TurnsByLogicalColour
turnsByLogicalColour
in if (Turn -> Bool) -> [Turn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MoveType -> Bool
Attribute.MoveType.isCastle (MoveType -> Bool) -> (Turn -> MoveType) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> MoveType)
-> (Turn -> QualifiedMove) -> Turn -> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove) [Turn]
turns
then AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
else (:) (
LogicalColour
logicalColour,
[
Coordinates -> X
Cartesian.Coordinates.getX Coordinates
coordinates |
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Turn] -> Bool
haveMovedFrom (LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour) [Turn]
turns,
Coordinates
coordinates <- LogicalColour -> [Coordinates]
Cartesian.Coordinates.rooksStartingCoordinates LogicalColour
logicalColour,
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates -> [Turn] -> Bool
haveMovedFrom Coordinates
coordinates [Turn]
turns Bool -> Bool -> Bool
|| Coordinates -> [Turn] -> Bool
haveMovedTo Coordinates
coordinates (LogicalColour -> TurnsByLogicalColour -> [Turn]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour) TurnsByLogicalColour
turnsByLogicalColour)
]
)
) [] [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members where
haveMovedFrom, haveMovedTo :: Cartesian.Coordinates.Coordinates -> [Component.Turn.Turn] -> Bool
haveMovedFrom :: Coordinates -> [Turn] -> Bool
haveMovedFrom Coordinates
coordinates = (Turn -> Bool) -> [Turn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Turn -> Bool) -> [Turn] -> Bool)
-> (Turn -> Bool) -> [Turn] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
coordinates) (Coordinates -> Bool) -> (Turn -> Coordinates) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getSource (Move -> Coordinates) -> (Turn -> Move) -> Turn -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove
haveMovedTo :: Coordinates -> [Turn] -> Bool
haveMovedTo Coordinates
coordinates = (Turn -> Bool) -> [Turn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Turn -> Bool) -> [Turn] -> Bool)
-> (Turn -> Bool) -> [Turn] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
coordinates) (Coordinates -> Bool) -> (Turn -> Coordinates) -> Turn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> Coordinates
Component.Move.getDestination (Move -> Coordinates) -> (Turn -> Move) -> Turn -> Coordinates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move) -> (Turn -> QualifiedMove) -> Turn -> Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove
hasCastled :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour -> Bool
hasCastled :: LogicalColour -> CastleableRooksByLogicalColour -> Bool
hasCastled LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
/= LogicalColour
logicalColour) (LogicalColour -> Bool)
-> ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst) AbscissaeByLogicalColour
assocs
canCastle :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour -> Bool
canCastle :: LogicalColour -> CastleableRooksByLogicalColour -> Bool
canCastle LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = Bool -> ([X] -> Bool) -> Maybe [X] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> ([X] -> Bool) -> [X] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Maybe [X] -> Bool) -> Maybe [X] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs
inferRooksOrdinate :: Attribute.LogicalColour.LogicalColour -> Type.Length.Y
inferRooksOrdinate :: LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour
| LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour = X
Cartesian.Ordinate.yMax
| Bool
otherwise = X
Cartesian.Ordinate.yMin
canCastleWith
:: Attribute.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates
-> CastleableRooksByLogicalColour
-> Bool
canCastleWith :: LogicalColour
-> Coordinates -> CastleableRooksByLogicalColour -> Bool
canCastleWith LogicalColour
logicalColour Coordinates
rookSource MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = Bool -> ([X] -> Bool) -> Maybe [X] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe Bool
False (
(X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((X -> Bool) -> [X] -> Bool) -> (X -> Bool) -> [X] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
rookSource) (Coordinates -> Bool) -> (X -> Coordinates) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> X -> Coordinates
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour)
) (Maybe [X] -> Bool) -> Maybe [X] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs
locateForLogicalColour :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour -> Maybe [Type.Length.X]
{-# INLINE locateForLogicalColour #-}
locateForLogicalColour :: LogicalColour -> CastleableRooksByLogicalColour -> Maybe [X]
locateForLogicalColour LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs
type Transformation = CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
unify :: Transformation
unify :: CastleableRooksByLogicalColour -> CastleableRooksByLogicalColour
unify MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> [LogicalColour]
-> AbscissaeByLogicalColour
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\LogicalColour
logicalColour AbscissaeByLogicalColour
assocs' -> (
if ((LogicalColour, [X]) -> Bool) -> AbscissaeByLogicalColour -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour) (LogicalColour -> Bool)
-> ((LogicalColour, [X]) -> LogicalColour)
-> (LogicalColour, [X])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalColour, [X]) -> LogicalColour
forall a b. (a, b) -> a
fst) AbscissaeByLogicalColour
assocs
then AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
else AbscissaeByLogicalColour -> AbscissaeByLogicalColour
sortByLogicalColour (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour
-> AbscissaeByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(LogicalColour
logicalColour, []) (LogicalColour, [X])
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> [a] -> [a]
:
)
) AbscissaeByLogicalColour
assocs'
) AbscissaeByLogicalColour
assocs [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
takeTurn
:: Attribute.LogicalColour.LogicalColour
-> Component.Turn.Turn
-> Transformation
takeTurn :: LogicalColour
-> Turn
-> CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
takeTurn LogicalColour
logicalColour Turn
turn MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour -> CastleableRooksByLogicalColour)
-> AbscissaeByLogicalColour -> CastleableRooksByLogicalColour
forall a b. (a -> b) -> a -> b
$ (
case LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour
assocs of
Just [] -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
Just [X]
rooksXs
| MoveType -> Bool
Attribute.MoveType.isCastle (MoveType -> Bool) -> MoveType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove
qualifiedMove -> LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
castle LogicalColour
logicalColour
| Turn -> Rank
Component.Turn.getRank Turn
turn Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.King -> LogicalColour
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
relinquishCastlingRights LogicalColour
logicalColour
| let source :: Coordinates
source = Move -> Coordinates
Component.Move.getSource Move
move
, (X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
source) (Coordinates -> Bool) -> (X -> Coordinates) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> X -> Coordinates
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour)
) [X]
rooksXs -> LogicalColour
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
removeX LogicalColour
logicalColour (X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ Coordinates -> X
Cartesian.Coordinates.getX Coordinates
source
| Bool
otherwise -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
Maybe [X]
_ -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
) (AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ (
let
opponentsLogicalColour :: LogicalColour
opponentsLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
in case LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
opponentsLogicalColour AbscissaeByLogicalColour
assocs of
Just [X]
rooksXs
| let destination :: Coordinates
destination = Move -> Coordinates
Component.Move.getDestination Move
move
, (X -> Bool) -> [X] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
destination) (Coordinates -> Bool) -> (X -> Coordinates) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X -> X -> Coordinates
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> X
inferRooksOrdinate LogicalColour
opponentsLogicalColour)
) [X]
rooksXs -> LogicalColour
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
removeX LogicalColour
opponentsLogicalColour (X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour)
-> X -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a b. (a -> b) -> a -> b
$ Coordinates -> X
Cartesian.Coordinates.getX Coordinates
destination
| Bool
otherwise -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
Maybe [X]
_ -> AbscissaeByLogicalColour -> AbscissaeByLogicalColour
forall a. a -> a
id
) AbscissaeByLogicalColour
assocs where
qualifiedMove :: QualifiedMove
qualifiedMove = Turn -> QualifiedMove
Component.Turn.getQualifiedMove Turn
turn
move :: Move
move = QualifiedMove -> Move
Component.QualifiedMove.getMove QualifiedMove
qualifiedMove
cantConverge
:: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> Bool
cantConverge :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Bool
cantConverge CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour' = (LogicalColour -> Bool) -> [LogicalColour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
\LogicalColour
logicalColour -> case ((CastleableRooksByLogicalColour -> Maybe [X])
-> CastleableRooksByLogicalColour -> Maybe [X]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour
castleableRooksByLogicalColour) ((CastleableRooksByLogicalColour -> Maybe [X]) -> Maybe [X])
-> ((CastleableRooksByLogicalColour -> Maybe [X]) -> Maybe [X])
-> (CastleableRooksByLogicalColour -> Maybe [X])
-> (Maybe [X], Maybe [X])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((CastleableRooksByLogicalColour -> Maybe [X])
-> CastleableRooksByLogicalColour -> Maybe [X]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour
castleableRooksByLogicalColour') ((CastleableRooksByLogicalColour -> Maybe [X])
-> (Maybe [X], Maybe [X]))
-> (CastleableRooksByLogicalColour -> Maybe [X])
-> (Maybe [X], Maybe [X])
forall a b. (a -> b) -> a -> b
$ LogicalColour -> CastleableRooksByLogicalColour -> Maybe [X]
locateForLogicalColour LogicalColour
logicalColour of
(Just [], Maybe [X]
Nothing) -> Bool
True
(Maybe [X]
Nothing, Just []) -> Bool
True
(Maybe [X], Maybe [X])
_ -> Bool
False
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
listIncrementalRandoms
:: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> Component.Zobrist.Zobrist random
-> [random]
listIncrementalRandoms :: CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour -> Zobrist random -> [random]
listIncrementalRandoms CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour' Zobrist random
zobrist = [
random
random |
CastleableRooksByLogicalColour
hashable <- [CastleableRooksByLogicalColour
castleableRooksByLogicalColour, CastleableRooksByLogicalColour
castleableRooksByLogicalColour'],
random
random <- CastleableRooksByLogicalColour -> Zobrist random -> [random]
forall hashable positionHash.
Hashable hashable =>
hashable -> Zobrist positionHash -> [positionHash]
StateProperty.Hashable.listRandoms CastleableRooksByLogicalColour
hashable Zobrist random
zobrist
]