module BishBosh.Component.Move(
NMoves,
NPlies,
Move(
getSource,
getDestination
),
tag,
nPliesPerMove,
castlingMovesByLogicalColour,
measureDistance,
interpolate,
getDeltaRadiusSquared,
mkMove,
isPawnDoubleAdvance
) 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.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Property.Reflectable as Property.Reflectable
import qualified BishBosh.Types as T
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Ord
tag :: String
tag :: String
tag = String
"move"
type NMoves = Int
type NPlies = NMoves
nPliesPerMove :: NMoves
nPliesPerMove :: NMoves
nPliesPerMove = NMoves
2
data Move x y = MkMove {
Move x y -> Coordinates x y
getSource :: Cartesian.Coordinates.Coordinates x y,
Move x y -> Coordinates x y
getDestination :: Cartesian.Coordinates.Coordinates x y
} deriving Move x y -> Move x y -> Bool
(Move x y -> Move x y -> Bool)
-> (Move x y -> Move x y -> Bool) -> Eq (Move x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y. (Eq x, Eq y) => Move x y -> Move x y -> Bool
/= :: Move x y -> Move x y -> Bool
$c/= :: forall x y. (Eq x, Eq y) => Move x y -> Move x y -> Bool
== :: Move x y -> Move x y -> Bool
$c== :: forall x y. (Eq x, Eq y) => Move x y -> Move x y -> Bool
Eq
instance (Ord x, Ord y) => Ord (Move x y) where
{-# SPECIALISE instance Ord (Move T.X T.Y) #-}
move :: Move x y
move@MkMove { getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source } compare :: Move x y -> Move x y -> Ordering
`compare` move' :: Move x y
move'@MkMove { getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source' } = case Coordinates x y
source Coordinates x y -> Coordinates x y -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Coordinates x y
source' of
Ordering
EQ -> (Move x y -> Coordinates x y) -> Move x y -> Move x y -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
getDestination Move x y
move Move x y
move'
Ordering
ordering -> Ordering
ordering
instance (Control.DeepSeq.NFData x, Control.DeepSeq.NFData y) => Control.DeepSeq.NFData (Move x y) where
rnf :: Move x y -> ()
rnf MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = (Coordinates x y, Coordinates x y) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (Coordinates x y
source, Coordinates x y
destination)
instance (Show x, Show y) => Show (Move x y) where
showsPrec :: NMoves -> Move x y -> ShowS
showsPrec NMoves
_ MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = (Coordinates x y, Coordinates x y) -> ShowS
forall a. Show a => a -> ShowS
shows (Coordinates x y
source, Coordinates x y
destination)
instance (
Enum x,
Enum y,
Ord x,
Ord y,
Read x,
Read y
) => Read (Move x y) where
readsPrec :: NMoves -> ReadS (Move x y)
readsPrec NMoves
_ = (((Coordinates x y, Coordinates x y), String)
-> (Move x y, String))
-> [((Coordinates x y, Coordinates x y), String)]
-> [(Move x y, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((Coordinates x y, Coordinates x y) -> Move x y)
-> ((Coordinates x y, Coordinates x y), String)
-> (Move x y, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (((Coordinates x y, Coordinates x y) -> Move x y)
-> ((Coordinates x y, Coordinates x y), String)
-> (Move x y, String))
-> ((Coordinates x y, Coordinates x y) -> Move x y)
-> ((Coordinates x y, Coordinates x y), String)
-> (Move x y, String)
forall a b. (a -> b) -> a -> b
$ (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
mkMove) ([((Coordinates x y, Coordinates x y), String)]
-> [(Move x y, String)])
-> (String -> [((Coordinates x y, Coordinates x y), String)])
-> ReadS (Move x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [((Coordinates x y, Coordinates x y), String)]
forall a. Read a => ReadS a
reads
instance Property.Opposable.Opposable (Move x y) where
getOpposite :: Move x y -> Move x y
getOpposite (MkMove Coordinates x y
source Coordinates x y
destination) = Coordinates x y -> Coordinates x y -> Move x y
forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove Coordinates x y
destination Coordinates x y
source
instance (Enum x, Enum y) => Property.Orientated.Orientated (Move x y) where
isDiagonal :: Move x y -> Bool
isDiagonal = (VectorInt -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isDiagonal :: Cartesian.Vector.VectorInt -> Bool) (VectorInt -> Bool) -> (Move x y -> VectorInt) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> VectorInt
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
measureDistance
isParallel :: Move x y -> Bool
isParallel = (VectorInt -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isParallel :: Cartesian.Vector.VectorInt -> Bool) (VectorInt -> Bool) -> (Move x y -> VectorInt) -> Move x y -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move x y -> VectorInt
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
measureDistance
instance Enum y => Property.Reflectable.ReflectableOnX (Move x y) where
reflectOnX :: Move x y -> Move x y
reflectOnX MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = MkMove :: forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove {
getSource :: Coordinates x y
getSource = Coordinates x y -> Coordinates x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Coordinates x y
source,
getDestination :: Coordinates x y
getDestination = Coordinates x y -> Coordinates x y
forall a. ReflectableOnX a => a -> a
Property.Reflectable.reflectOnX Coordinates x y
destination
}
instance Enum x => Property.Reflectable.ReflectableOnY (Move x y) where
reflectOnY :: Move x y -> Move x y
reflectOnY MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = MkMove :: forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove {
getSource :: Coordinates x y
getSource = Coordinates x y -> Coordinates x y
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY Coordinates x y
source,
getDestination :: Coordinates x y
getDestination = Coordinates x y -> Coordinates x y
forall a. ReflectableOnY a => a -> a
Property.Reflectable.reflectOnY Coordinates x y
destination
}
mkMove
:: (Eq x, Eq y)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Move x y
{-# INLINE mkMove #-}
mkMove :: Coordinates x y -> Coordinates x y -> Move x y
mkMove Coordinates x y
source Coordinates x y
destination = Bool -> Move x y -> Move x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates x y
source Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
/= Coordinates x y
destination) (Move x y -> Move x y) -> Move x y -> Move x y
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> Move x y
forall x y. Coordinates x y -> Coordinates x y -> Move x y
MkMove Coordinates x y
source Coordinates x y
destination
measureDistance :: (
Enum x,
Enum y,
Num distance,
Ord distance
) => Move x y -> Cartesian.Vector.Vector distance
{-# SPECIALISE measureDistance :: Move T.X T.Y -> Cartesian.Vector.VectorInt #-}
measureDistance :: Move x y -> Vector distance
measureDistance MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = Coordinates x y -> Coordinates x y -> Vector distance
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Coordinates x y -> Coordinates x y -> Vector distance
Cartesian.Vector.measureDistance Coordinates x y
source Coordinates x y
destination
interpolate :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Move x y -> [Cartesian.Coordinates.Coordinates x y]
{-# SPECIALISE interpolate :: Move T.X T.Y -> [Cartesian.Coordinates.Coordinates T.X T.Y] #-}
interpolate :: Move x y -> [Coordinates x y]
interpolate move :: Move x y
move@MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = Bool -> [Coordinates x y] -> [Coordinates x y]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Move x y -> Bool
forall a. Orientated a => a -> Bool
Property.Orientated.isStraight Move x y
move) ([Coordinates x y] -> [Coordinates x y])
-> [Coordinates x y] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Coordinates x y -> [Coordinates x y]
Cartesian.Coordinates.interpolate Coordinates x y
source Coordinates x y
destination
castlingMovesByLogicalColour :: (
Enum x,
Enum y,
Eq y,
Ord x
) => Attribute.LogicalColour.ByLogicalColour [(Attribute.MoveType.MoveType, Move x y, Move x y)]
castlingMovesByLogicalColour :: ByLogicalColour [(MoveType, Move x y, Move x y)]
castlingMovesByLogicalColour = [[(MoveType, Move x y, Move x y)]]
-> ByLogicalColour [(MoveType, Move x y, Move x y)]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour ([[(MoveType, Move x y, Move x y)]]
-> ByLogicalColour [(MoveType, Move x y, Move x y)])
-> [[(MoveType, Move x y, Move x y)]]
-> ByLogicalColour [(MoveType, Move x y, Move x y)]
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> [(MoveType, Move x y, Move x y)])
-> [LogicalColour] -> [[(MoveType, Move x y, Move x y)]]
forall a b. (a -> b) -> [a] -> [b]
map (
\LogicalColour
logicalColour -> let
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 :: (NMoves -> NMoves) -> Move x y
kingsMove NMoves -> NMoves
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
mkMove Coordinates x y
kingsStartingCoordinates (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX NMoves -> NMoves
translation Coordinates x y
kingsStartingCoordinates
in [
(
MoveType
Attribute.MoveType.shortCastle,
(NMoves -> NMoves) -> Move x y
kingsMove (NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+ NMoves
2),
(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
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')
&&& (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX (NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
subtract NMoves
2)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
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
), (
MoveType
Attribute.MoveType.longCastle,
(NMoves -> NMoves) -> Move x y
kingsMove ((NMoves -> NMoves) -> Move x y) -> (NMoves -> NMoves) -> Move x y
forall a b. (a -> b) -> a -> b
$ NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
subtract NMoves
2,
(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
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')
&&& (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Ord x) =>
(NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX (NMoves -> NMoves -> NMoves
forall a. Num a => a -> a -> a
+ NMoves
3)) (Coordinates x y -> Move x y) -> Coordinates x y -> Move x y
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
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
)
]
) [LogicalColour]
Attribute.LogicalColour.range where
translateX :: (Enum x, Ord x) => (Int -> Int) -> Cartesian.Coordinates.Coordinates x y -> Cartesian.Coordinates.Coordinates x y
translateX :: (NMoves -> NMoves) -> Coordinates x y -> Coordinates x y
translateX NMoves -> NMoves
translation = (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)
-> (x -> x) -> Coordinates x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ NMoves -> x
forall a. Enum a => NMoves -> a
toEnum (NMoves -> x) -> (x -> NMoves) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NMoves -> NMoves
translation (NMoves -> NMoves) -> (x -> NMoves) -> x -> NMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NMoves
forall a. Enum a => a -> NMoves
fromEnum
isPawnDoubleAdvance
:: (Enum x, Enum y, Eq y)
=> Attribute.LogicalColour.LogicalColour
-> Move x y
-> Bool
isPawnDoubleAdvance :: LogicalColour -> Move x y -> Bool
isPawnDoubleAdvance LogicalColour
logicalColour Move x y
move = LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
logicalColour (
Move x y -> Coordinates x y
forall x y. Move x y -> Coordinates x y
getSource Move x y
move
) Bool -> Bool -> Bool
&& LogicalColour -> VectorInt -> Bool
forall distance.
(Eq distance, Num distance) =>
LogicalColour -> Vector distance -> Bool
Cartesian.Vector.matchesPawnDoubleAdvance LogicalColour
logicalColour (
Move x y -> VectorInt
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Move x y -> Vector distance
measureDistance Move x y
move :: Cartesian.Vector.VectorInt
)
getDeltaRadiusSquared :: (
Fractional radiusSquared,
Integral x,
Integral y
) => Move x y -> radiusSquared
{-# SPECIALISE getDeltaRadiusSquared :: Move T.X T.Y -> T.RadiusSquared #-}
getDeltaRadiusSquared :: Move x y -> radiusSquared
getDeltaRadiusSquared MkMove {
getSource :: forall x y. Move x y -> Coordinates x y
getSource = Coordinates x y
source,
getDestination :: forall x y. Move x y -> Coordinates x y
getDestination = Coordinates x y
destination
} = ByCoordinates x y radiusSquared
forall radiusSquared x y.
(Fractional radiusSquared, Integral x, Integral y) =>
ByCoordinates x y radiusSquared
Cartesian.Coordinates.radiusSquared ByCoordinates x y radiusSquared -> Coordinates x y -> radiusSquared
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates x y
destination radiusSquared -> radiusSquared -> radiusSquared
forall a. Num a => a -> a -> a
- ByCoordinates x y radiusSquared
forall radiusSquared x y.
(Fractional radiusSquared, Integral x, Integral y) =>
ByCoordinates x y radiusSquared
Cartesian.Coordinates.radiusSquared ByCoordinates x y radiusSquared -> Coordinates x y -> radiusSquared
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates x y
source