{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
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.Enum as Data.Enum
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.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.Array.IArray
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 x = [(Attribute.LogicalColour.LogicalColour, [x])]
sortByLogicalColour :: AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
sortByLogicalColour :: AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
sortByLogicalColour = ((LogicalColour, [x]) -> (LogicalColour, [x]) -> Ordering)
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((LogicalColour, [x]) -> (LogicalColour, [x]) -> Ordering)
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> ((LogicalColour, [x]) -> (LogicalColour, [x]) -> Ordering)
-> AbscissaeByLogicalColour x
-> AbscissaeByLogicalColour x
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 x -> AbscissaeByLogicalColour x
castle :: LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
castle LogicalColour
logicalColour = ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. (a -> Bool) -> [a] -> [a]
filter (((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x
-> AbscissaeByLogicalColour x
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 x -> AbscissaeByLogicalColour x
relinquishCastlingRights :: LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
relinquishCastlingRights LogicalColour
logicalColour = ((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a b. (a -> b) -> [a] -> [b]
map (((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> ((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x
-> AbscissaeByLogicalColour x
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 :: Eq x => Attribute.LogicalColour.LogicalColour -> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
removeX :: LogicalColour
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
removeX LogicalColour
logicalColour x
x = ((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a b. (a -> b) -> [a] -> [b]
map (((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> ((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x
-> AbscissaeByLogicalColour x
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'
:: Eq x
=> Attribute.LogicalColour.LogicalColour
-> x
-> AbscissaeByLogicalColour x
-> Bool
canCastleWith' :: LogicalColour -> x -> AbscissaeByLogicalColour x -> 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 x -> Maybe [x])
-> AbscissaeByLogicalColour x
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> AbscissaeByLogicalColour x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour
newtype CastleableRooksByLogicalColour x = MkCastleableRooksByLogicalColour {
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs :: AbscissaeByLogicalColour x
} deriving (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
(CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool)
-> Eq (CastleableRooksByLogicalColour x)
forall x.
Eq x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
$c/= :: forall x.
Eq x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
== :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
$c== :: forall x.
Eq x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
Eq, Eq (CastleableRooksByLogicalColour x)
Eq (CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Ordering)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x)
-> (CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x)
-> Ord (CastleableRooksByLogicalColour x)
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Ordering
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
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
forall x. Ord x => Eq (CastleableRooksByLogicalColour x)
forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Ordering
forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
min :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
$cmin :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
max :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
$cmax :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
>= :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
$c>= :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
> :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
$c> :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
<= :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
$c<= :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
< :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
$c< :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
compare :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Ordering
$ccompare :: forall x.
Ord x =>
CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (CastleableRooksByLogicalColour x)
Ord)
instance Show x => Show (CastleableRooksByLogicalColour x) where
showsPrec :: Int -> CastleableRooksByLogicalColour x -> ShowS
showsPrec Int
precedence MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = Int -> AbscissaeByLogicalColour x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence AbscissaeByLogicalColour x
assocs
instance (
Enum x,
Ord x,
Read x,
Show x
) => Read (CastleableRooksByLogicalColour x) where
readsPrec :: Int -> ReadS (CastleableRooksByLogicalColour x)
readsPrec Int
precedence String
s = (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> (AbscissaeByLogicalColour x, String)
-> (CastleableRooksByLogicalColour x, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
(Enum x, Ord x, Show x) =>
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
fromAssocs ((AbscissaeByLogicalColour x, String)
-> (CastleableRooksByLogicalColour x, String))
-> [(AbscissaeByLogicalColour x, String)]
-> [(CastleableRooksByLogicalColour x, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` Int -> ReadS (AbscissaeByLogicalColour x)
forall a. Read a => Int -> ReadS a
readsPrec Int
precedence String
s
instance Control.DeepSeq.NFData x => Control.DeepSeq.NFData (CastleableRooksByLogicalColour x) where
rnf :: CastleableRooksByLogicalColour x -> ()
rnf MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = AbscissaeByLogicalColour x -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf AbscissaeByLogicalColour x
assocs
instance Enum x => Data.Default.Default (CastleableRooksByLogicalColour x) where
def :: CastleableRooksByLogicalColour x
def = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, [x]))
-> [LogicalColour] -> AbscissaeByLogicalColour x
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
forall x. Enum x => x
Cartesian.Abscissa.xMin, x
forall x. Enum x => x
Cartesian.Abscissa.xMax]
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
instance Property.Reflectable.ReflectableOnX (CastleableRooksByLogicalColour x) where
reflectOnX :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
reflectOnX MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> (AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> AbscissaeByLogicalColour x
-> CastleableRooksByLogicalColour x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. [a] -> [a]
reverse (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
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 x
assocs
instance (
Enum x,
Ord x,
Show x
) => Property.ExtendedPositionDescription.ReadsEPD (CastleableRooksByLogicalColour x) where
readsEPD :: ReadS (CastleableRooksByLogicalColour x)
readsEPD String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
'-' : String
remainder -> [
(
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members [LogicalColour] -> [[x]] -> AbscissaeByLogicalColour x
forall a b. [a] -> [b] -> [(a, b)]
`zip` [x] -> [[x]]
forall a. a -> [a]
repeat [],
String
remainder
)
]
String
s1 -> let
readsAssocs :: String -> [([(LogicalColour, b)], 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, b)], 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, b)] -> [(LogicalColour, b)])
-> ([(LogicalColour, b)], String) -> ([(LogicalColour, b)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
(
LogicalColour
logicalColour,
b
forall x. Enum x => x
Cartesian.Abscissa.xMin
) (LogicalColour, b) -> [(LogicalColour, b)] -> [(LogicalColour, b)]
forall a. a -> [a] -> [a]
:
) (([(LogicalColour, b)], String) -> ([(LogicalColour, b)], String))
-> [([(LogicalColour, b)], String)]
-> [([(LogicalColour, b)], String)]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [([(LogicalColour, b)], String)]
readsAssocs String
s''
Rank
Attribute.Rank.King -> ([(LogicalColour, b)] -> [(LogicalColour, b)])
-> ([(LogicalColour, b)], String) -> ([(LogicalColour, b)], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
(
LogicalColour
logicalColour,
b
forall x. Enum x => x
Cartesian.Abscissa.xMax
) (LogicalColour, b) -> [(LogicalColour, b)] -> [(LogicalColour, b)]
forall a. a -> [a] -> [a]
:
) (([(LogicalColour, b)], String) -> ([(LogicalColour, b)], String))
-> [([(LogicalColour, b)], String)]
-> [([(LogicalColour, b)], String)]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [([(LogicalColour, b)], String)]
readsAssocs String
s''
Rank
_ -> []
where
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
Component.Piece.getLogicalColour Piece
piece
[(Piece, String)]
_ -> [([(LogicalColour, b)], String)]
forall a. [([a], String)]
terminate
where
terminate :: [([a], String)]
terminate = [([], String
s')]
in case String -> [([(LogicalColour, x)], String)]
forall b. Enum b => String -> [([(LogicalColour, b)], String)]
readsAssocs String
s1 of
[([], String
_)] -> []
[([(LogicalColour, x)], String)]
l -> ([(LogicalColour, x)] -> CastleableRooksByLogicalColour x)
-> ([(LogicalColour, x)], String)
-> (CastleableRooksByLogicalColour x, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
(Enum x, Ord x, Show x) =>
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
fromAssocs (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> ([(LogicalColour, x)] -> AbscissaeByLogicalColour x)
-> [(LogicalColour, x)]
-> CastleableRooksByLogicalColour x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LogicalColour, x)] -> AbscissaeByLogicalColour x
forall k v. Ord k => [(k, v)] -> [(k, [v])]
Data.List.Extra.groupSort) (([(LogicalColour, x)], String)
-> (CastleableRooksByLogicalColour x, String))
-> [([(LogicalColour, x)], String)]
-> [(CastleableRooksByLogicalColour x, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` [([(LogicalColour, x)], String)]
l
instance (Enum x, Eq x) => Property.ExtendedPositionDescription.ShowsEPD (CastleableRooksByLogicalColour x) where
showsEPD :: CastleableRooksByLogicalColour x -> ShowS
showsEPD MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs }
| ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> 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 x
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
forall x. Enum x => x
Cartesian.Abscissa.xMax, LogicalColour -> Piece
Component.Piece.mkKing), (x
forall x. Enum x => x
Cartesian.Abscissa.xMin, LogicalColour -> Piece
Component.Piece.mkQueen)],
LogicalColour -> x -> AbscissaeByLogicalColour x -> Bool
forall x.
Eq x =>
LogicalColour -> x -> AbscissaeByLogicalColour x -> Bool
canCastleWith' LogicalColour
logicalColour x
rooksX AbscissaeByLogicalColour x
assocs
]
instance (
Enum x,
Ord x,
Show x
) => Property.ForsythEdwards.ReadsFEN (CastleableRooksByLogicalColour x)
instance (Enum x, Eq x) => Property.ForsythEdwards.ShowsFEN (CastleableRooksByLogicalColour x)
instance Eq x => Component.Zobrist.Hashable1D CastleableRooksByLogicalColour x where
listRandoms1D :: CastleableRooksByLogicalColour x
-> Zobrist x y positionHash -> [positionHash]
listRandoms1D MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } Zobrist x y positionHash
zobrist = [Maybe positionHash] -> [positionHash]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes [
LogicalColour
-> x -> Zobrist x y positionHash -> Maybe positionHash
forall x y positionHash.
Eq x =>
LogicalColour
-> x -> Zobrist x y positionHash -> Maybe positionHash
Component.Zobrist.dereferenceRandomByCastleableRooksXByLogicalColour LogicalColour
logicalColour x
x Zobrist x y 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 x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour x
assocs
]
fromAssocs :: (
Enum x,
Ord x,
Show x
) => AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
fromAssocs :: AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
fromAssocs AbscissaeByLogicalColour x
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 x -> [LogicalColour]
forall a b. (a -> b) -> [a] -> [b]
map (LogicalColour, [x]) -> LogicalColour
forall a b. (a, b) -> a
fst AbscissaeByLogicalColour x
assocs = Exception -> CastleableRooksByLogicalColour x
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour x)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour x
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 x)
-> String -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour x -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour x
assocs String
"."
| ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> 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 x
assocs = Exception -> CastleableRooksByLogicalColour x
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour x)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour x
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 x)
-> String -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour x -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour x
assocs String
"."
| ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> 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
forall x. Enum x => x
Cartesian.Abscissa.xMin, x
forall x. Enum x => 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 x
assocs = Exception -> CastleableRooksByLogicalColour x
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour x)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour x
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 x)
-> String -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ AbscissaeByLogicalColour x -> ShowS
forall a. Show a => a -> ShowS
shows AbscissaeByLogicalColour x
assocs String
"."
| Bool
otherwise = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> (AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> AbscissaeByLogicalColour x
-> CastleableRooksByLogicalColour x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall x. AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
sortByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ ((LogicalColour, [x]) -> (LogicalColour, [x]))
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
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 x
assocs
fromBoard :: (
Enum x,
Enum y,
Ord x,
Ord y,
Show x
) => State.Board.Board x y -> CastleableRooksByLogicalColour x
fromBoard :: Board x y -> CastleableRooksByLogicalColour x
fromBoard Board x y
board
| (LogicalColour -> Bool) -> [LogicalColour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
\LogicalColour
logicalColour -> LogicalColour -> CastleableRooksByLogicalColour x -> Bool
forall x. LogicalColour -> CastleableRooksByLogicalColour x -> Bool
hasCastled LogicalColour
logicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour Bool -> Bool -> Bool
&& (Coordinates x y -> Bool) -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (
Coordinates x y -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
forall x y.
LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Pawn CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour
) [
x -> y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Coordinates x y
Cartesian.Coordinates.mkCoordinates x
x (
LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.pawnsFirstRank LogicalColour
logicalColour
) |
x
bishopsAbscissa <- [
(x -> x) -> x -> x
forall x. (Enum x, Ord x) => (x -> x) -> x -> x
Cartesian.Abscissa.translate ((Int -> Int) -> x -> x
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) x
forall x. Enum x => x
Cartesian.Abscissa.xMin,
(x -> x) -> x -> x
forall x. (Enum x, Ord x) => (x -> x) -> x -> x
Cartesian.Abscissa.translate ((Int -> Int) -> x -> x
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate ((Int -> Int) -> x -> x) -> (Int -> Int) -> x -> x
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2) x
forall x. Enum x => x
Cartesian.Abscissa.xMax
],
x
x <- x -> [x]
forall x. (Enum x, Eq x) => x -> [x]
Cartesian.Abscissa.getAdjacents x
bishopsAbscissa
]
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members = Exception -> CastleableRooksByLogicalColour x
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CastleableRooksByLogicalColour x)
-> (String -> Exception)
-> String
-> CastleableRooksByLogicalColour x
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 x)
-> String -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ (CastleableRooksByLogicalColour x, Board x y) -> ShowS
forall a. Show a => a -> ShowS
shows (CastleableRooksByLogicalColour x
castleableRooksByLogicalColour, Board x y
board) String
"."
| Bool
otherwise = CastleableRooksByLogicalColour x
castleableRooksByLogicalColour
where
coordinatesByRankByLogicalColour :: CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour = Board x y -> CoordinatesByRankByLogicalColour x y
forall x y. Board x y -> CoordinatesByRankByLogicalColour x y
State.Board.getCoordinatesByRankByLogicalColour Board x y
board
castleableRooksByLogicalColour :: CastleableRooksByLogicalColour x
castleableRooksByLogicalColour = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
(Enum x, Ord x, Show x) =>
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
fromAssocs (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> (LogicalColour, [x]))
-> [LogicalColour] -> AbscissaeByLogicalColour x
forall a b. (a -> b) -> [a] -> [b]
map (
\LogicalColour
logicalColour -> (
LogicalColour
logicalColour,
[
Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
rooksCoordinates |
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
forall x y.
LogicalColour
-> CoordinatesByRankByLogicalColour x y -> Coordinates x y
State.CoordinatesByRankByLogicalColour.getKingsCoordinates LogicalColour
logicalColour CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour,
Coordinates x y
rooksCoordinates <- LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
forall x y.
LogicalColour
-> Rank
-> CoordinatesByRankByLogicalColour x y
-> [Coordinates x y]
State.CoordinatesByRankByLogicalColour.dereference LogicalColour
logicalColour Rank
Attribute.Rank.Rook CoordinatesByRankByLogicalColour x y
coordinatesByRankByLogicalColour,
Coordinates x y
rooksCoordinates Coordinates x y -> [Coordinates x y] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LogicalColour -> [Coordinates x y]
forall x y. (Enum x, Enum y) => LogicalColour -> [Coordinates x y]
Cartesian.Coordinates.rooksStartingCoordinates LogicalColour
logicalColour
]
)
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
type TurnsByLogicalColour x y = State.TurnsByLogicalColour.TurnsByLogicalColour (Component.Turn.Turn x y)
fromTurnsByLogicalColour :: (
Enum x,
Enum y,
Eq x,
Eq y
) => TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
fromTurnsByLogicalColour :: TurnsByLogicalColour x y -> CastleableRooksByLogicalColour x
fromTurnsByLogicalColour TurnsByLogicalColour x y
turnsByLogicalColour = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ (LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> AbscissaeByLogicalColour x
-> [LogicalColour]
-> AbscissaeByLogicalColour x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\LogicalColour
logicalColour -> let
turns :: [Turn x y]
turns = LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference LogicalColour
logicalColour TurnsByLogicalColour x y
turnsByLogicalColour
in if (Turn x y -> Bool) -> [Turn x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MoveType -> Bool
Attribute.MoveType.isCastle (MoveType -> Bool) -> (Turn x y -> MoveType) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove x y -> MoveType)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> MoveType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove) [Turn x y]
turns
then AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> a
id
else (:) (
LogicalColour
logicalColour,
[
Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
coordinates |
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> [Turn x y] -> Bool
forall x y. (Eq x, Eq y) => Coordinates x y -> [Turn x y] -> Bool
haveMovedFrom (LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour) [Turn x y]
turns,
Coordinates x y
coordinates <- LogicalColour -> [Coordinates x y]
forall x y. (Enum x, Enum y) => LogicalColour -> [Coordinates x y]
Cartesian.Coordinates.rooksStartingCoordinates LogicalColour
logicalColour,
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> [Turn x y] -> Bool
forall x y. (Eq x, Eq y) => Coordinates x y -> [Turn x y] -> Bool
haveMovedFrom Coordinates x y
coordinates [Turn x y]
turns Bool -> Bool -> Bool
|| Coordinates x y -> [Turn x y] -> Bool
forall x y. (Eq x, Eq y) => Coordinates x y -> [Turn x y] -> Bool
haveMovedTo Coordinates x y
coordinates (LogicalColour -> TurnsByLogicalColour x y -> [Turn x y]
forall turn. LogicalColour -> TurnsByLogicalColour turn -> [turn]
State.TurnsByLogicalColour.dereference (LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour) TurnsByLogicalColour x y
turnsByLogicalColour)
]
)
) [] [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members where
haveMovedFrom, haveMovedTo :: (Eq x, Eq y) => Cartesian.Coordinates.Coordinates x y -> [Component.Turn.Turn x y] -> Bool
haveMovedFrom :: Coordinates x y -> [Turn x y] -> Bool
haveMovedFrom Coordinates x y
coordinates = (Turn x y -> Bool) -> [Turn x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Turn x y -> Bool) -> [Turn x y] -> Bool)
-> (Turn x y -> Bool) -> [Turn x y] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
coordinates) (Coordinates x y -> Bool)
-> (Turn x y -> Coordinates x y) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource (Move x y -> Coordinates x y)
-> (Turn x y -> Move x y) -> Turn x y -> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
haveMovedTo :: Coordinates x y -> [Turn x y] -> Bool
haveMovedTo Coordinates x y
coordinates = (Turn x y -> Bool) -> [Turn x y] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Turn x y -> Bool) -> [Turn x y] -> Bool)
-> (Turn x y -> Bool) -> [Turn x y] -> Bool
forall a b. (a -> b) -> a -> b
$ (Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
coordinates) (Coordinates x y -> Bool)
-> (Turn x y -> Coordinates x y) -> Turn x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination (Move x y -> Coordinates x y)
-> (Turn x y -> Move x y) -> Turn x y -> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove (QualifiedMove x y -> Move x y)
-> (Turn x y -> QualifiedMove x y) -> Turn x y -> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove
hasCastled :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour x -> Bool
hasCastled :: LogicalColour -> CastleableRooksByLogicalColour x -> Bool
hasCastled LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> 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 x
assocs
canCastle :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour x -> Bool
canCastle :: LogicalColour -> CastleableRooksByLogicalColour x -> Bool
canCastle LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
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 x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour x
assocs
inferRooksOrdinate :: Enum y => Attribute.LogicalColour.LogicalColour -> y
inferRooksOrdinate :: LogicalColour -> y
inferRooksOrdinate LogicalColour
logicalColour
| LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour = y
forall x. Enum x => x
Cartesian.Ordinate.yMax
| Bool
otherwise = y
forall x. Enum x => x
Cartesian.Ordinate.yMin
canCastleWith :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Cartesian.Coordinates.Coordinates x y
-> CastleableRooksByLogicalColour x
-> Bool
canCastleWith :: LogicalColour
-> Coordinates x y -> CastleableRooksByLogicalColour x -> Bool
canCastleWith LogicalColour
logicalColour Coordinates x y
rookSource MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
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 x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
rookSource) (Coordinates x y -> Bool) -> (x -> Coordinates x y) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Coordinates x y
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> y
forall y. Enum y => LogicalColour -> y
inferRooksOrdinate LogicalColour
logicalColour)
) (Maybe [x] -> Bool) -> Maybe [x] -> Bool
forall a b. (a -> b) -> a -> b
$ LogicalColour -> AbscissaeByLogicalColour x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour x
assocs
locateForLogicalColour :: Attribute.LogicalColour.LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
{-# INLINE locateForLogicalColour #-}
locateForLogicalColour :: LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
locateForLogicalColour LogicalColour
logicalColour MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = LogicalColour -> AbscissaeByLogicalColour x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour x
assocs
type Transformation x = CastleableRooksByLogicalColour x -> CastleableRooksByLogicalColour x
unify :: Transformation x
unify :: Transformation x
unify MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ (LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> AbscissaeByLogicalColour x
-> [LogicalColour]
-> AbscissaeByLogicalColour x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
\LogicalColour
logicalColour AbscissaeByLogicalColour x
assocs' -> (
if ((LogicalColour, [x]) -> Bool)
-> AbscissaeByLogicalColour x -> 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 x
assocs
then AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> a
id
else AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall x. AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
sortByLogicalColour (AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> (AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> AbscissaeByLogicalColour x
-> AbscissaeByLogicalColour x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
(LogicalColour
logicalColour, []) (LogicalColour, [x])
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> [a] -> [a]
:
)
) AbscissaeByLogicalColour x
assocs'
) AbscissaeByLogicalColour x
assocs [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
takeTurn :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Attribute.LogicalColour.LogicalColour
-> Component.Turn.Turn x y
-> Transformation x
{-# SPECIALISE takeTurn :: Attribute.LogicalColour.LogicalColour -> Component.Turn.Turn Type.Length.X Type.Length.Y -> Transformation Type.Length.X #-}
takeTurn :: LogicalColour -> Turn x y -> Transformation x
takeTurn LogicalColour
logicalColour Turn x y
turn MkCastleableRooksByLogicalColour { getAssocs :: forall x.
CastleableRooksByLogicalColour x -> AbscissaeByLogicalColour x
getAssocs = AbscissaeByLogicalColour x
assocs } = AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall x.
AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
MkCastleableRooksByLogicalColour (AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x)
-> AbscissaeByLogicalColour x -> CastleableRooksByLogicalColour x
forall a b. (a -> b) -> a -> b
$ (
case LogicalColour -> AbscissaeByLogicalColour x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
logicalColour AbscissaeByLogicalColour x
assocs of
Just [] -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
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 x y -> MoveType
forall x y. QualifiedMove x y -> MoveType
Component.QualifiedMove.getMoveType QualifiedMove x y
qualifiedMove -> LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall x.
LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
castle LogicalColour
logicalColour
| Turn x y -> Rank
forall x y. Turn x y -> Rank
Component.Turn.getRank Turn x y
turn Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
Attribute.Rank.King -> LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall x.
LogicalColour
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
relinquishCastlingRights LogicalColour
logicalColour
| let source :: Coordinates x y
source = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getSource Move x y
move
, (x -> Bool) -> [x] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
source) (Coordinates x y -> Bool) -> (x -> Coordinates x y) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Coordinates x y
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> y
forall y. Enum y => LogicalColour -> y
inferRooksOrdinate LogicalColour
logicalColour)
) [x]
rooksXs -> LogicalColour
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall x.
Eq x =>
LogicalColour
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
removeX LogicalColour
logicalColour (x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
source
| Bool
otherwise -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> a
id
Maybe [x]
_ -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> a
id
) (AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
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 x -> Maybe [x]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup LogicalColour
opponentsLogicalColour AbscissaeByLogicalColour x
assocs of
Just [x]
rooksXs
| let destination :: Coordinates x y
destination = Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
Component.Move.getDestination Move x y
move
, (x -> Bool) -> [x] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
(Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
destination) (Coordinates x y -> Bool) -> (x -> Coordinates x y) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Coordinates x y
`Cartesian.Coordinates.mkCoordinates` LogicalColour -> y
forall y. Enum y => LogicalColour -> y
inferRooksOrdinate LogicalColour
opponentsLogicalColour)
) [x]
rooksXs -> LogicalColour
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall x.
Eq x =>
LogicalColour
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
removeX LogicalColour
opponentsLogicalColour (x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x)
-> x -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> x
forall x y. Coordinates x y -> x
Cartesian.Coordinates.getX Coordinates x y
destination
| Bool
otherwise -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> a
id
Maybe [x]
_ -> AbscissaeByLogicalColour x -> AbscissaeByLogicalColour x
forall a. a -> a
id
) AbscissaeByLogicalColour x
assocs where
qualifiedMove :: QualifiedMove x y
qualifiedMove = Turn x y -> QualifiedMove x y
forall x y. Turn x y -> QualifiedMove x y
Component.Turn.getQualifiedMove Turn x y
turn
move :: Move x y
move = QualifiedMove x y -> Move x y
forall x y. QualifiedMove x y -> Move x y
Component.QualifiedMove.getMove QualifiedMove x y
qualifiedMove
cantConverge
:: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Bool
cantConverge :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x -> Bool
cantConverge CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour' = (LogicalColour -> Bool) -> [LogicalColour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
\LogicalColour
logicalColour -> case ((CastleableRooksByLogicalColour x -> Maybe [x])
-> CastleableRooksByLogicalColour x -> Maybe [x]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour x
castleableRooksByLogicalColour) ((CastleableRooksByLogicalColour x -> Maybe [x]) -> Maybe [x])
-> ((CastleableRooksByLogicalColour x -> Maybe [x]) -> Maybe [x])
-> (CastleableRooksByLogicalColour x -> Maybe [x])
-> (Maybe [x], Maybe [x])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((CastleableRooksByLogicalColour x -> Maybe [x])
-> CastleableRooksByLogicalColour x -> Maybe [x]
forall a b. (a -> b) -> a -> b
$ CastleableRooksByLogicalColour x
castleableRooksByLogicalColour') ((CastleableRooksByLogicalColour x -> Maybe [x])
-> (Maybe [x], Maybe [x]))
-> (CastleableRooksByLogicalColour x -> Maybe [x])
-> (Maybe [x], Maybe [x])
forall a b. (a -> b) -> a -> b
$ LogicalColour -> CastleableRooksByLogicalColour x -> Maybe [x]
forall x.
LogicalColour -> CastleableRooksByLogicalColour x -> 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
:: Data.Array.IArray.Ix x
=> CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Component.Zobrist.Zobrist x y random
-> [random]
listIncrementalRandoms :: CastleableRooksByLogicalColour x
-> CastleableRooksByLogicalColour x
-> Zobrist x y random
-> [random]
listIncrementalRandoms CastleableRooksByLogicalColour x
castleableRooksByLogicalColour CastleableRooksByLogicalColour x
castleableRooksByLogicalColour' Zobrist x y random
zobrist = [
random
random |
CastleableRooksByLogicalColour x
hashable <- [CastleableRooksByLogicalColour x
castleableRooksByLogicalColour, CastleableRooksByLogicalColour x
castleableRooksByLogicalColour'],
random
random <- CastleableRooksByLogicalColour x -> Zobrist x y random -> [random]
forall (hashable :: * -> *) x y positionHash.
Hashable1D hashable x =>
hashable x -> Zobrist x y positionHash -> [positionHash]
Component.Zobrist.listRandoms1D CastleableRooksByLogicalColour x
hashable Zobrist x y random
zobrist
]