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.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.Colour.LogicalColour as Colour.LogicalColour
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 = [(Colour.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 :: Colour.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 :: Colour.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
:: Colour.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'
:: AbscissaeByLogicalColour
-> Colour.LogicalColour.LogicalColour
-> Type.Length.X
-> Bool
canCastleWith' :: AbscissaeByLogicalColour -> LogicalColour -> X -> Bool
canCastleWith' AbscissaeByLogicalColour
abscissaeByLogicalColour 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) -> 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
abscissaeByLogicalColour
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
Colour.LogicalColour.White, LogicalColour
Colour.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)],
AbscissaeByLogicalColour -> LogicalColour -> X -> Bool
canCastleWith' AbscissaeByLogicalColour
assocs LogicalColour
logicalColour X
rooksX
]
instance Property.ForsythEdwards.ReadsFEN CastleableRooksByLogicalColour
instance Property.ForsythEdwards.ShowsFEN CastleableRooksByLogicalColour
instance StateProperty.Hashable.Hashable CastleableRooksByLogicalColour where
listRandoms :: Zobrist positionHash
-> CastleableRooksByLogicalColour -> [positionHash]
listRandoms Zobrist positionHash
zobrist MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = [Maybe positionHash] -> [positionHash]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes [
Zobrist positionHash -> LogicalColour -> X -> Maybe positionHash
forall positionHash.
Zobrist positionHash -> LogicalColour -> X -> Maybe positionHash
Component.Zobrist.dereferenceRandomByCastleableRooksXByLogicalColour Zobrist positionHash
zobrist LogicalColour
logicalColour X
x |
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 -> CastleableRooksByLogicalColour -> LogicalColour -> Bool
hasCastled CastleableRooksByLogicalColour
castleableRooksByLogicalColour LogicalColour
logicalColour 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` CoordinatesByRankByLogicalColour
-> LogicalColour -> Rank -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour LogicalColour
logicalColour Rank
Attribute.Rank.Pawn
) [
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 |
(Coordinates -> Coordinates -> Bool)
-> (Coordinates, Coordinates) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Coordinates, Coordinates) -> Bool)
-> (Coordinates, Coordinates) -> Bool
forall a b. (a -> b) -> a -> b
$ (CoordinatesByRankByLogicalColour -> LogicalColour -> Coordinates
State.CoordinatesByRankByLogicalColour.getKingsCoordinates CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour (LogicalColour -> Coordinates)
-> (LogicalColour -> Coordinates)
-> LogicalColour
-> (Coordinates, Coordinates)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Coordinates
Cartesian.Coordinates.kingsStartingCoordinates) LogicalColour
logicalColour,
Coordinates
rooksCoordinates <- CoordinatesByRankByLogicalColour
-> LogicalColour -> Rank -> [Coordinates]
State.CoordinatesByRankByLogicalColour.dereference CoordinatesByRankByLogicalColour
coordinatesByRankByLogicalColour LogicalColour
logicalColour Rank
Attribute.Rank.Rook,
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 = TurnsByLogicalColour -> LogicalColour -> [Turn]
forall turn. TurnsByLogicalColour turn -> LogicalColour -> [turn]
State.TurnsByLogicalColour.dereference TurnsByLogicalColour
turnsByLogicalColour LogicalColour
logicalColour
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 (TurnsByLogicalColour -> LogicalColour -> [Turn]
forall turn. TurnsByLogicalColour turn -> LogicalColour -> [turn]
State.TurnsByLogicalColour.dereference TurnsByLogicalColour
turnsByLogicalColour (LogicalColour -> [Turn]) -> LogicalColour -> [Turn]
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour)
]
)
) [] [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 :: CastleableRooksByLogicalColour -> Colour.LogicalColour.LogicalColour -> Bool
hasCastled :: CastleableRooksByLogicalColour -> LogicalColour -> Bool
hasCastled MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } LogicalColour
logicalColour = ((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 :: CastleableRooksByLogicalColour -> Colour.LogicalColour.LogicalColour -> Bool
canCastle :: CastleableRooksByLogicalColour -> LogicalColour -> Bool
canCastle 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)
-> (LogicalColour -> Maybe [X]) -> LogicalColour -> 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` AbscissaeByLogicalColour
assocs)
inferRooksOrdinate :: Colour.LogicalColour.LogicalColour -> Type.Length.Y
inferRooksOrdinate :: LogicalColour -> X
inferRooksOrdinate LogicalColour
logicalColour
| LogicalColour -> Bool
Colour.LogicalColour.isBlack LogicalColour
logicalColour = X
Cartesian.Ordinate.yMax
| Bool
otherwise = X
Cartesian.Ordinate.yMin
canCastleWith
:: CastleableRooksByLogicalColour
-> Colour.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates
-> Bool
canCastleWith :: CastleableRooksByLogicalColour
-> LogicalColour -> Coordinates -> Bool
canCastleWith MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } LogicalColour
logicalColour Coordinates
rookSource = 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 :: CastleableRooksByLogicalColour -> Colour.LogicalColour.LogicalColour -> Maybe [Type.Length.X]
{-# INLINE locateForLogicalColour #-}
locateForLogicalColour :: CastleableRooksByLogicalColour -> LogicalColour -> Maybe [X]
locateForLogicalColour MkCastleableRooksByLogicalColour { getAssocs :: CastleableRooksByLogicalColour -> AbscissaeByLogicalColour
getAssocs = AbscissaeByLogicalColour
assocs } = (LogicalColour -> AbscissaeByLogicalColour -> Maybe [X]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` 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
:: Colour.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
$ (CastleableRooksByLogicalColour -> LogicalColour -> 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
:: Component.Zobrist.Zobrist random
-> CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> [random]
listIncrementalRandoms :: Zobrist random
-> CastleableRooksByLogicalColour
-> CastleableRooksByLogicalColour
-> [random]
listIncrementalRandoms Zobrist random
zobrist CastleableRooksByLogicalColour
castleableRooksByLogicalColour CastleableRooksByLogicalColour
castleableRooksByLogicalColour' = Zobrist random -> [CastleableRooksByLogicalColour] -> [random]
forall hashable positionHash.
Hashable hashable =>
Zobrist positionHash -> hashable -> [positionHash]
StateProperty.Hashable.listRandoms Zobrist random
zobrist [CastleableRooksByLogicalColour
castleableRooksByLogicalColour, CastleableRooksByLogicalColour
castleableRooksByLogicalColour']