module BishBosh.Component.CastlingMove(
CastlingMove(
getMoveType,
getKingsMove,
getRooksMove
),
kingsMoveLength,
getLongAndShortMoves,
getCastlingMoves,
) where
import Control.Arrow((&&&))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.MoveType as Attribute.MoveType
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Component.Move as Component.Move
import qualified BishBosh.Data.Enum as Data.Enum
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.Exception
data CastlingMove x y = MkCastlingMove {
CastlingMove x y -> MoveType
getMoveType :: Attribute.MoveType.MoveType,
CastlingMove x y -> Move x y
getKingsMove :: Component.Move.Move x y,
CastlingMove x y -> Move x y
getRooksMove :: Component.Move.Move x y
}
kingsMoveLength :: Num x => x
kingsMoveLength :: x
kingsMoveLength = x
2
defineCastlingMoves :: (
Enum x,
Enum y,
Eq y,
Ord x
) => Attribute.LogicalColour.LogicalColour -> [CastlingMove x y]
defineCastlingMoves :: LogicalColour -> [CastlingMove x y]
defineCastlingMoves LogicalColour
logicalColour = [
MkCastlingMove :: forall x y. MoveType -> Move x y -> Move x y -> CastlingMove x y
MkCastlingMove {
getMoveType :: MoveType
getMoveType = MoveType
Attribute.MoveType.longCastle,
getKingsMove :: Move x y
getKingsMove = (Int -> Int) -> Move x y
kingsMove ((Int -> Int) -> Move x y) -> (Int -> Int) -> Move x y
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
forall x. Num x => x
kingsMoveLength,
getRooksMove :: Move x y
getRooksMove = (Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y -> (Coordinates x y, Coordinates x y))
-> Coordinates x y
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Coordinates x y
forall a. a -> a
id (Coordinates x y -> Coordinates x y)
-> (Coordinates x y -> Coordinates x y)
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Int -> Int) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(Int -> Int) -> Coordinates x y -> Coordinates x y
translateX (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if Bool
isBlack
then Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
Cartesian.Coordinates.topLeft
else Coordinates x y
forall a. Bounded a => a
minBound
}, MkCastlingMove :: forall x y. MoveType -> Move x y -> Move x y -> CastlingMove x y
MkCastlingMove {
getMoveType :: MoveType
getMoveType = MoveType
Attribute.MoveType.shortCastle,
getKingsMove :: Move x y
getKingsMove = (Int -> Int) -> Move x y
kingsMove (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forall x. Num x => x
kingsMoveLength),
getRooksMove :: Move x y
getRooksMove = (Coordinates x y -> Coordinates x y -> Move x y)
-> (Coordinates x y, Coordinates x y) -> Move x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove ((Coordinates x y, Coordinates x y) -> Move x y)
-> (Coordinates x y -> (Coordinates x y, Coordinates x y))
-> Coordinates x y
-> Move x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> Coordinates x y
forall a. a -> a
id (Coordinates x y -> Coordinates x y)
-> (Coordinates x y -> Coordinates x y)
-> Coordinates x y
-> (Coordinates x y, Coordinates x y)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Int -> Int) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(Int -> Int) -> Coordinates x y -> Coordinates x y
translateX (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if Bool
isBlack
then Coordinates x y
forall a. Bounded a => a
maxBound
else Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
Cartesian.Coordinates.bottomRight
}
] where
isBlack :: Bool
isBlack :: Bool
isBlack = LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
kingsStartingCoordinates :: Coordinates x y
kingsStartingCoordinates = LogicalColour -> Coordinates x y
forall x y. (Enum x, Enum y) => LogicalColour -> Coordinates x y
Cartesian.Coordinates.kingsStartingCoordinates LogicalColour
logicalColour
kingsMove :: (Int -> Int) -> Move x y
kingsMove Int -> Int
translation = Coordinates x y -> Coordinates x y -> Move x y
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Move x y
Component.Move.mkMove Coordinates x y
kingsStartingCoordinates (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(Int -> Int) -> Coordinates x y -> Coordinates x y
translateX Int -> Int
translation Coordinates x y
kingsStartingCoordinates
translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y
translateX :: (Int -> Int) -> Coordinates x y -> Coordinates x y
translateX = (x -> x) -> Coordinates x y -> Coordinates x y
forall x y. (Enum x, Ord x) => (x -> x) -> Transformation x y
Cartesian.Coordinates.translateX ((x -> x) -> Coordinates x y -> Coordinates x y)
-> ((Int -> Int) -> x -> x)
-> (Int -> Int)
-> Coordinates x y
-> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> x -> x
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate
castlingMovesByLogicalColour :: (
Enum x,
Enum y,
Eq y,
Ord x
) => Attribute.LogicalColour.ArrayByLogicalColour [CastlingMove x y]
castlingMovesByLogicalColour :: ArrayByLogicalColour [CastlingMove x y]
castlingMovesByLogicalColour = [[CastlingMove x y]] -> ArrayByLogicalColour [CastlingMove x y]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([[CastlingMove x y]] -> ArrayByLogicalColour [CastlingMove x y])
-> [[CastlingMove x y]] -> ArrayByLogicalColour [CastlingMove x y]
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> [CastlingMove x y])
-> [LogicalColour] -> [[CastlingMove x y]]
forall a b. (a -> b) -> [a] -> [b]
map LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
defineCastlingMoves [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
getCastlingMoves :: (
Enum x,
Enum y,
Eq y,
Ord x
) => Attribute.LogicalColour.LogicalColour -> [CastlingMove x y]
{-# NOINLINE getCastlingMoves #-}
{-# RULES "getCastlingMoves/Int" getCastlingMoves = getCastlingMovesInt #-}
getCastlingMoves :: LogicalColour -> [CastlingMove x y]
getCastlingMoves = LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
defineCastlingMoves
getCastlingMovesInt :: Attribute.LogicalColour.LogicalColour -> [CastlingMove Type.Length.X Type.Length.Y]
getCastlingMovesInt :: LogicalColour -> [CastlingMove Int Int]
getCastlingMovesInt = (ArrayByLogicalColour [CastlingMove Int Int]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
ArrayByLogicalColour [CastlingMove x y]
castlingMovesByLogicalColour ArrayByLogicalColour [CastlingMove Int Int]
-> LogicalColour -> [CastlingMove Int Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)
getLongAndShortMoves :: (
Enum x,
Enum y,
Eq y,
Ord x
) => Attribute.LogicalColour.LogicalColour -> (CastlingMove x y, CastlingMove x y)
{-# SPECIALISE getLongAndShortMoves :: Attribute.LogicalColour.LogicalColour -> (CastlingMove Type.Length.X Type.Length.Y, CastlingMove Type.Length.X Type.Length.Y) #-}
getLongAndShortMoves :: LogicalColour -> (CastlingMove x y, CastlingMove x y)
getLongAndShortMoves LogicalColour
logicalColour
| [CastlingMove x y
longCastlingMove, CastlingMove x y
shortCastlingMove] <- LogicalColour -> [CastlingMove x y]
forall x y.
(Enum x, Enum y, Eq y, Ord x) =>
LogicalColour -> [CastlingMove x y]
getCastlingMoves LogicalColour
logicalColour = (CastlingMove x y
longCastlingMove, CastlingMove x y
shortCastlingMove)
| Bool
otherwise = Exception -> (CastlingMove x y, CastlingMove x y)
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> (CastlingMove x y, CastlingMove x y))
-> Exception -> (CastlingMove x y, CastlingMove x y)
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkIncompatibleData String
"BishBosh.Component.CastlingMove.getLongAndShortMoves:\tunexpected list-length."