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